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-2006, 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 2,  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 COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  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 Fname;    use Fname;
  33 with Lib;      use Lib;
  34 with Namet;    use Namet;
  35 with Nlists;   use Nlists;
  36 with Opt;      use Opt;
  37 with Output;   use Output;
  38 with Rtsfind;  use Rtsfind;
  39 with Sinfo;    use Sinfo;
  40 with Sinput;   use Sinput;
  41 with Sinput.D; use Sinput.D;
  42 with Snames;   use Snames;
  43 with Stand;    use Stand;
  44 with Stringt;  use Stringt;
  45 with Uintp;    use Uintp;
  46 with Uname;    use Uname;
  47 with Urealp;   use Urealp;
  48
  49 package body Sprint is
  50
  51    Debug_Node : Node_Id := Empty;
  52    --  If we are in Debug_Generated_Code mode, then this location is set
  53    --  to the current node requiring Sloc fixup, until Set_Debug_Sloc is
  54    --  called to set the proper value. The call clears it back to Empty.
  55
  56    Debug_Sloc : Source_Ptr;
  57    --  Sloc of first byte of line currently being written if we are
  58    --  generating a source debug file.
  59
  60    Dump_Original_Only : Boolean;
  61    --  Set True if the -gnatdo (dump original tree) flag is set
  62
  63    Dump_Generated_Only : Boolean;
  64    --  Set True if the -gnatG (dump generated tree) debug flag is set
  65    --  or for Print_Generated_Code (-gnatG) or Dump_Generated_Code (-gnatD).
  66
  67    Dump_Freeze_Null : Boolean;
  68    --  Set True if freeze nodes and non-source null statements output
  69
  70    Indent : Int := 0;
  71    --  Number of columns for current line output indentation
  72
  73    Indent_Annull_Flag : Boolean := False;
  74    --  Set True if subsequent Write_Indent call to be ignored, gets reset
  75    --  by this call, so it is only active to suppress a single indent call.
  76
  77    Line_Limit : constant := 72;
  78    --  Limit value for chopping long lines
  79
  80    Freeze_Indent : Int := 0;
  81    --  Keep track of freeze indent level (controls blank lines before
  82    --  procedures within expression freeze actions)
  83
  84    -------------------------------
  85    -- Operator Precedence Table --
  86    -------------------------------
  87
  88    --  This table is used to decide whether a subexpression needs to be
  89    --  parenthesized. The rule is that if an operand of an operator (which
  90    --  for this purpose includes AND THEN and OR ELSE) is itself an operator
  91    --  with a lower precedence than the operator (or equal precedence if
  92    --  appearing as the right operand), then parentheses are required.
  93
  94    Op_Prec : constant array (N_Subexpr) of Short_Short_Integer :=
  95                (N_Op_And          => 1,
  96                 N_Op_Or           => 1,
  97                 N_Op_Xor          => 1,
  98                 N_And_Then        => 1,
  99                 N_Or_Else         => 1,
 100
 101                 N_In              => 2,
 102                 N_Not_In          => 2,
 103                 N_Op_Eq           => 2,
 104                 N_Op_Ge           => 2,
 105                 N_Op_Gt           => 2,
 106                 N_Op_Le           => 2,
 107                 N_Op_Lt           => 2,
 108                 N_Op_Ne           => 2,
 109
 110                 N_Op_Add          => 3,
 111                 N_Op_Concat       => 3,
 112                 N_Op_Subtract     => 3,
 113                 N_Op_Plus         => 3,
 114                 N_Op_Minus        => 3,
 115
 116                 N_Op_Divide       => 4,
 117                 N_Op_Mod          => 4,
 118                 N_Op_Rem          => 4,
 119                 N_Op_Multiply     => 4,
 120
 121                 N_Op_Expon        => 5,
 122                 N_Op_Abs          => 5,
 123                 N_Op_Not          => 5,
 124
 125                 others            => 6);
 126
 127    procedure Sprint_Left_Opnd (N : Node_Id);
 128    --  Print left operand of operator, parenthesizing if necessary
 129
 130    procedure Sprint_Right_Opnd (N : Node_Id);
 131    --  Print right operand of operator, parenthesizing if necessary
 132
 133    -----------------------
 134    -- Local Subprograms --
 135    -----------------------
 136
 137    procedure Col_Check (N : Nat);
 138    --  Check that at least N characters remain on current line, and if not,
 139    --  then start an extra line with two characters extra indentation for
 140    --  continuing text on the next line.
 141
 142    procedure Indent_Annull;
 143    --  Causes following call to Write_Indent to be ignored. This is used when
 144    --  a higher level node wants to stop a lower level node from starting a
 145    --  new line, when it would otherwise be inclined to do so (e.g. the case
 146    --  of an accept statement called from an accept alternative with a guard)
 147
 148    procedure Indent_Begin;
 149    --  Increase indentation level
 150
 151    procedure Indent_End;
 152    --  Decrease indentation level
 153
 154    procedure Note_Implicit_Run_Time_Call (N : Node_Id);
 155    --  N is the Name field of a function call or procedure statement call.
 156    --  The effect of the call is to output a $ if the call is identified as
 157    --  an implicit call to a run time routine.
 158
 159    procedure Print_Debug_Line (S : String);
 160    --  Used to print output lines in Debug_Generated_Code mode (this is used
 161    --  as the argument for a call to Set_Special_Output in package Output).
 162
 163    procedure Process_TFAI_RR_Flags (Nod : Node_Id);
 164    --  Given a divide, multiplication or division node, check the flags
 165    --  Treat_Fixed_As_Integer and Rounded_Flags, and if set, output the
 166    --  appropriate special syntax characters (# and @).
 167
 168    procedure Set_Debug_Sloc;
 169    --  If Debug_Node is non-empty, this routine sets the appropriate value
 170    --  in its Sloc field, from the current location in the debug source file
 171    --  that is currently being written. Note that Debug_Node is always empty
 172    --  if a debug source file is not being written.
 173
 174    procedure Sprint_And_List (List : List_Id);
 175    --  Print the given list with items separated by vertical "and"
 176
 177    procedure Sprint_Bar_List (List : List_Id);
 178    --  Print the given list with items separated by vertical bars
 179
 180    procedure Sprint_Node_Actual (Node : Node_Id);
 181    --  This routine prints its node argument. It is a lower level routine than
 182    --  Sprint_Node, in that it does not bother about rewritten trees.
 183
 184    procedure Sprint_Node_Sloc (Node : Node_Id);
 185    --  Like Sprint_Node, but in addition, in Debug_Generated_Code mode,
 186    --  sets the Sloc of the current debug node to be a copy of the Sloc
 187    --  of the sprinted node Node. Note that this is done after printing
 188    --  Node, so that the Sloc is the proper updated value for the debug file.
 189
 190    procedure Write_Char_Sloc (C : Character);
 191    --  Like Write_Char, except that if C is non-blank, Set_Debug_Sloc is
 192    --  called to ensure that the current node has a proper Sloc set.
 193
 194    procedure Write_Condition_And_Reason (Node : Node_Id);
 195    --  Write Condition and Reason codes of Raise_xxx_Error node
 196
 197    procedure Write_Discr_Specs (N : Node_Id);
 198    --  Ouput discriminant specification for node, which is any of the type
 199    --  declarations that can have discriminants.
 200
 201    procedure Write_Ekind (E : Entity_Id);
 202    --  Write the String corresponding to the Ekind without "E_"
 203
 204    procedure Write_Id (N : Node_Id);
 205    --  N is a node with a Chars field. This procedure writes the name that
 206    --  will be used in the generated code associated with the name. For a
 207    --  node with no associated entity, this is simply the Chars field. For
 208    --  the case where there is an entity associated with the node, we print
 209    --  the name associated with the entity (since it may have been encoded).
 210    --  One other special case is that an entity has an active external name
 211    --  (i.e. an external name present with no address clause), then this
 212    --  external name is output. This procedure also deals with outputting
 213    --  declarations of referenced itypes, if not output earlier.
 214
 215    function Write_Identifiers (Node : Node_Id) return Boolean;
 216    --  Handle node where the grammar has a list of defining identifiers, but
 217    --  the tree has a separate declaration for each identifier. Handles the
 218    --  printing of the defining identifier, and returns True if the type and
 219    --  initialization information is to be printed, False if it is to be
 220    --  skipped (the latter case happens when printing defining identifiers
 221    --  other than the first in the original tree output case).
 222
 223    procedure Write_Implicit_Def (E : Entity_Id);
 224    pragma Warnings (Off, Write_Implicit_Def);
 225    --  Write the definition of the implicit type E according to its Ekind
 226    --  For now a debugging procedure, but might be used in the future.
 227
 228    procedure Write_Indent;
 229    --  Start a new line and write indentation spacing
 230
 231    function Write_Indent_Identifiers (Node : Node_Id) return Boolean;
 232    --  Like Write_Identifiers except that each new printed declaration
 233    --  is at the start of a new line.
 234
 235    function Write_Indent_Identifiers_Sloc (Node : Node_Id) return Boolean;
 236    --  Like Write_Indent_Identifiers except that in Debug_Generated_Code
 237    --  mode, the Sloc of the current debug node is set to point ot the
 238    --  first output identifier.
 239
 240    procedure Write_Indent_Str (S : String);
 241    --  Start a new line and write indent spacing followed by given string
 242
 243    procedure Write_Indent_Str_Sloc (S : String);
 244    --  Like Write_Indent_Str, but in addition, in Debug_Generated_Code mode,
 245    --  the Sloc of the current node is set to the first non-blank character
 246    --  in the string S.
 247
 248    procedure Write_Itype (Typ : Entity_Id);
 249    --  If Typ is an Itype that has not been written yet, write it. If Typ is
 250    --  any other kind of entity or tree node, the call is ignored.
 251
 252    procedure Write_Name_With_Col_Check (N : Name_Id);
 253    --  Write name (using Write_Name) with initial column check, and possible
 254    --  initial Write_Indent (to get new line) if current line is too full.
 255
 256    procedure Write_Name_With_Col_Check_Sloc (N : Name_Id);
 257    --  Like Write_Name_With_Col_Check but in addition, in Debug_Generated_Code
 258    --  mode, sets Sloc of current debug node to first character of name.
 259
 260    procedure Write_Operator (N : Node_Id; S : String);
 261    --  Like Write_Str_Sloc, used for operators, encloses the string in
 262    --  characters {} if the Do_Overflow flag is set on the node N.
 263
 264    procedure Write_Param_Specs (N : Node_Id);
 265    --  Output parameter specifications for node (which is either a function
 266    --  or procedure specification with a Parameter_Specifications field)
 267
 268    procedure Write_Rewrite_Str (S : String);
 269    --  Writes out a string (typically containing <<< or >>>}) for a node
 270    --  created by rewriting the tree. Suppressed if we are outputting the
 271    --  generated code only, since in this case we don't specially mark nodes
 272    --  created by rewriting).
 273
 274    procedure Write_Str_Sloc (S : String);
 275    --  Like Write_Str, but sets debug Sloc of current debug node to first
 276    --  non-blank character if a current debug node is active.
 277
 278    procedure Write_Str_With_Col_Check (S : String);
 279    --  Write string (using Write_Str) with initial column check, and possible
 280    --  initial Write_Indent (to get new line) if current line is too full.
 281
 282    procedure Write_Str_With_Col_Check_Sloc (S : String);
 283    --  Like Write_Str_WIth_Col_Check, but sets debug Sloc of current debug
 284    --  node to first non-blank character if a current debug node is active.
 285
 286    procedure Write_Uint_With_Col_Check (U : Uint; Format : UI_Format);
 287    --  Write Uint (using UI_Write) with initial column check, and possible
 288    --  initial Write_Indent (to get new line) if current line is too full.
 289    --  The format parameter determines the output format (see UI_Write).
 290
 291    procedure Write_Uint_With_Col_Check_Sloc (U : Uint; Format : UI_Format);
 292    --  Write Uint (using UI_Write) with initial column check, and possible
 293    --  initial Write_Indent (to get new line) if current line is too full.
 294    --  The format parameter determines the output format (see UI_Write).
 295    --  In addition, in Debug_Generated_Code mode, sets the current node
 296    --  Sloc to the first character of the output value.
 297
 298    procedure Write_Ureal_With_Col_Check_Sloc (U : Ureal);
 299    --  Write Ureal (using same output format as UR_Write) with column checks
 300    --  and a possible initial Write_Indent (to get new line) if current line
 301    --  is too full. In addition, in Debug_Generated_Code mode, sets the
 302    --  current node Sloc to the first character of the output value.
 303
 304    ---------------
 305    -- Col_Check --
 306    ---------------
 307
 308    procedure Col_Check (N : Nat) is
 309    begin
 310       if N + Column > Line_Limit then
 311          Write_Indent_Str ("  ");
 312       end if;
 313    end Col_Check;
 314
 315    -------------------
 316    -- Indent_Annull --
 317    -------------------
 318
 319    procedure Indent_Annull is
 320    begin
 321       Indent_Annull_Flag := True;
 322    end Indent_Annull;
 323
 324    ------------------
 325    -- Indent_Begin --
 326    ------------------
 327
 328    procedure Indent_Begin is
 329    begin
 330       Indent := Indent + 3;
 331    end Indent_Begin;
 332
 333    ----------------
 334    -- Indent_End --
 335    ----------------
 336
 337    procedure Indent_End is
 338    begin
 339       Indent := Indent - 3;
 340    end Indent_End;
 341
 342    ---------------------------------
 343    -- Note_Implicit_Run_Time_Call --
 344    ---------------------------------
 345
 346    procedure Note_Implicit_Run_Time_Call (N : Node_Id) is
 347    begin
 348       if not Comes_From_Source (N)
 349         and then Is_Entity_Name (N)
 350       then
 351          declare
 352             Ent : constant Entity_Id := Entity (N);
 353          begin
 354             if not In_Extended_Main_Source_Unit (Ent)
 355               and then
 356                 Is_Predefined_File_Name
 357                   (Unit_File_Name (Get_Source_Unit (Ent)))
 358             then
 359                Col_Check (Length_Of_Name (Chars (Ent)));
 360                Write_Char ('$');
 361             end if;
 362          end;
 363       end if;
 364    end Note_Implicit_Run_Time_Call;
 365
 366    --------
 367    -- pg --
 368    --------
 369
 370    procedure pg (Node : Node_Id) is
 371    begin
 372       Dump_Generated_Only := True;
 373       Dump_Original_Only := False;
 374       Sprint_Node (Node);
 375       Write_Eol;
 376    end pg;
 377
 378    --------
 379    -- po --
 380    --------
 381
 382    procedure po (Node : Node_Id) is
 383    begin
 384       Dump_Generated_Only := False;
 385       Dump_Original_Only := True;
 386       Sprint_Node (Node);
 387       Write_Eol;
 388    end po;
 389
 390    ----------------------
 391    -- Print_Debug_Line --
 392    ----------------------
 393
 394    procedure Print_Debug_Line (S : String) is
 395    begin
 396       Write_Debug_Line (S, Debug_Sloc);
 397    end Print_Debug_Line;
 398
 399    ---------------------------
 400    -- Process_TFAI_RR_Flags --
 401    ---------------------------
 402
 403    procedure Process_TFAI_RR_Flags (Nod : Node_Id) is
 404    begin
 405       if Treat_Fixed_As_Integer (Nod) then
 406          Write_Char ('#');
 407       end if;
 408
 409       if Rounded_Result (Nod) then
 410          Write_Char ('@');
 411       end if;
 412    end Process_TFAI_RR_Flags;
 413
 414    --------
 415    -- ps --
 416    --------
 417
 418    procedure ps (Node : Node_Id) is
 419    begin
 420       Dump_Generated_Only := False;
 421       Dump_Original_Only := False;
 422       Sprint_Node (Node);
 423       Write_Eol;
 424    end ps;
 425
 426    --------------------
 427    -- Set_Debug_Sloc --
 428    --------------------
 429
 430    procedure Set_Debug_Sloc is
 431    begin
 432       if Present (Debug_Node) then
 433          Set_Sloc (Debug_Node, Debug_Sloc + Source_Ptr (Column - 1));
 434          Debug_Node := Empty;
 435       end if;
 436    end Set_Debug_Sloc;
 437
 438    -----------------
 439    -- Source_Dump --
 440    -----------------
 441
 442    procedure Source_Dump is
 443
 444       procedure Underline;
 445       --  Put underline under string we just printed
 446
 447       procedure Underline is
 448          Col : constant Int := Column;
 449
 450       begin
 451          Write_Eol;
 452
 453          while Col > Column loop
 454             Write_Char ('-');
 455          end loop;
 456
 457          Write_Eol;
 458       end Underline;
 459
 460    --  Start of processing for Tree_Dump
 461
 462    begin
 463       Dump_Generated_Only := Debug_Flag_G or
 464                              Print_Generated_Code or
 465                              Debug_Generated_Code;
 466       Dump_Original_Only  := Debug_Flag_O;
 467       Dump_Freeze_Null    := Debug_Flag_S or Debug_Flag_G;
 468
 469       --  Note that we turn off the tree dump flags immediately, before
 470       --  starting the dump. This avoids generating two copies of the dump
 471       --  if an abort occurs after printing the dump, and more importantly,
 472       --  avoids an infinite loop if an abort occurs during the dump.
 473
 474       if Debug_Flag_Z then
 475          Debug_Flag_Z := False;
 476          Write_Eol;
 477          Write_Eol;
 478          Write_Str ("Source recreated from tree of Standard (spec)");
 479          Underline;
 480          Sprint_Node (Standard_Package_Node);
 481          Write_Eol;
 482          Write_Eol;
 483       end if;
 484
 485       if Debug_Flag_S or Dump_Generated_Only or Dump_Original_Only then
 486          Debug_Flag_G := False;
 487          Debug_Flag_O := False;
 488          Debug_Flag_S := False;
 489
 490          --  Dump requested units
 491
 492          for U in Main_Unit .. Last_Unit loop
 493
 494             --  Dump all units if -gnatdf set, otherwise we dump only
 495             --  the source files that are in the extended main source.
 496
 497             if Debug_Flag_F
 498               or else In_Extended_Main_Source_Unit (Cunit_Entity (U))
 499             then
 500                --  If we are generating debug files, setup to write them
 501
 502                if Debug_Generated_Code then
 503                   Set_Special_Output (Print_Debug_Line'Access);
 504                   Create_Debug_Source (Source_Index (U), Debug_Sloc);
 505                   Sprint_Node (Cunit (U));
 506                   Write_Eol;
 507                   Close_Debug_Source;
 508                   Set_Special_Output (null);
 509
 510                --  Normal output to standard output file
 511
 512                else
 513                   Write_Str ("Source recreated from tree for ");
 514                   Write_Unit_Name (Unit_Name (U));
 515                   Underline;
 516                   Sprint_Node (Cunit (U));
 517                   Write_Eol;
 518                   Write_Eol;
 519                end if;
 520             end if;
 521          end loop;
 522       end if;
 523    end Source_Dump;
 524
 525    ---------------------
 526    -- Sprint_And_List --
 527    ---------------------
 528
 529    procedure Sprint_And_List (List : List_Id) is
 530       Node : Node_Id;
 531    begin
 532       if Is_Non_Empty_List (List) then
 533          Node := First (List);
 534          loop
 535             Sprint_Node (Node);
 536             Next (Node);
 537             exit when Node = Empty;
 538             Write_Str (" and ");
 539          end loop;
 540       end if;
 541    end Sprint_And_List;
 542
 543    ---------------------
 544    -- Sprint_Bar_List --
 545    ---------------------
 546
 547    procedure Sprint_Bar_List (List : List_Id) is
 548       Node : Node_Id;
 549    begin
 550       if Is_Non_Empty_List (List) then
 551          Node := First (List);
 552          loop
 553             Sprint_Node (Node);
 554             Next (Node);
 555             exit when Node = Empty;
 556             Write_Str (" | ");
 557          end loop;
 558       end if;
 559    end Sprint_Bar_List;
 560
 561    -----------------------
 562    -- Sprint_Comma_List --
 563    -----------------------
 564
 565    procedure Sprint_Comma_List (List : List_Id) is
 566       Node : Node_Id;
 567
 568    begin
 569       if Is_Non_Empty_List (List) then
 570          Node := First (List);
 571          loop
 572             Sprint_Node (Node);
 573             Next (Node);
 574             exit when Node = Empty;
 575
 576             if not Is_Rewrite_Insertion (Node)
 577               or else not Dump_Original_Only
 578             then
 579                Write_Str (", ");
 580             end if;
 581          end loop;
 582       end if;
 583    end Sprint_Comma_List;
 584
 585    --------------------------
 586    -- Sprint_Indented_List --
 587    --------------------------
 588
 589    procedure Sprint_Indented_List (List : List_Id) is
 590    begin
 591       Indent_Begin;
 592       Sprint_Node_List (List);
 593       Indent_End;
 594    end Sprint_Indented_List;
 595
 596    ---------------------
 597    -- Sprint_Left_Opnd --
 598    ---------------------
 599
 600    procedure Sprint_Left_Opnd (N : Node_Id) is
 601       Opnd : constant Node_Id := Left_Opnd (N);
 602
 603    begin
 604       if Paren_Count (Opnd) /= 0
 605         or else Op_Prec (Nkind (Opnd)) >= Op_Prec (Nkind (N))
 606       then
 607          Sprint_Node (Opnd);
 608
 609       else
 610          Write_Char ('(');
 611          Sprint_Node (Opnd);
 612          Write_Char (')');
 613       end if;
 614    end Sprint_Left_Opnd;
 615
 616    -----------------
 617    -- Sprint_Node --
 618    -----------------
 619
 620    procedure Sprint_Node (Node : Node_Id) is
 621    begin
 622       if Is_Rewrite_Insertion (Node) then
 623          if not Dump_Original_Only then
 624
 625             --  For special cases of nodes that always output <<< >>>
 626             --  do not duplicate the output at this point.
 627
 628             if Nkind (Node) = N_Freeze_Entity
 629               or else Nkind (Node) = N_Implicit_Label_Declaration
 630             then
 631                Sprint_Node_Actual (Node);
 632
 633             --  Normal case where <<< >>> may be required
 634
 635             else
 636                Write_Rewrite_Str ("<<<");
 637                Sprint_Node_Actual (Node);
 638                Write_Rewrite_Str (">>>");
 639             end if;
 640          end if;
 641
 642       elsif Is_Rewrite_Substitution (Node) then
 643
 644          --  Case of dump generated only
 645
 646          if Dump_Generated_Only then
 647             Sprint_Node_Actual (Node);
 648
 649          --  Case of dump original only
 650
 651          elsif Dump_Original_Only then
 652             Sprint_Node_Actual (Original_Node (Node));
 653
 654          --  Case of both being dumped
 655
 656          else
 657             Sprint_Node_Actual (Original_Node (Node));
 658             Write_Rewrite_Str ("<<<");
 659             Sprint_Node_Actual (Node);
 660             Write_Rewrite_Str (">>>");
 661          end if;
 662
 663       else
 664          Sprint_Node_Actual (Node);
 665       end if;
 666    end Sprint_Node;
 667
 668    ------------------------
 669    -- Sprint_Node_Actual --
 670    ------------------------
 671
 672    procedure Sprint_Node_Actual (Node : Node_Id) is
 673       Save_Debug_Node : constant Node_Id := Debug_Node;
 674
 675    begin
 676       if Node = Empty then
 677          return;
 678       end if;
 679
 680       for J in 1 .. Paren_Count (Node) loop
 681          Write_Str_With_Col_Check ("(");
 682       end loop;
 683
 684       --  Setup node for Sloc fixup if writing a debug source file. Note
 685       --  that we take care of any previous node not yet properly set.
 686
 687       if Debug_Generated_Code then
 688          Debug_Node := Node;
 689       end if;
 690
 691       if Nkind (Node) in N_Subexpr
 692         and then Do_Range_Check (Node)
 693       then
 694          Write_Str_With_Col_Check ("{");
 695       end if;
 696
 697       --  Select print circuit based on node kind
 698
 699       case Nkind (Node) is
 700
 701          when N_Abort_Statement =>
 702             Write_Indent_Str_Sloc ("abort ");
 703             Sprint_Comma_List (Names (Node));
 704             Write_Char (';');
 705
 706          when N_Abortable_Part =>
 707             Set_Debug_Sloc;
 708             Write_Str_Sloc ("abort ");
 709             Sprint_Indented_List (Statements (Node));
 710
 711          when N_Abstract_Subprogram_Declaration =>
 712             Write_Indent;
 713             Sprint_Node (Specification (Node));
 714             Write_Str_With_Col_Check (" is ");
 715             Write_Str_Sloc ("abstract;");
 716
 717          when N_Accept_Alternative =>
 718             Sprint_Node_List (Pragmas_Before (Node));
 719
 720             if Present (Condition (Node)) then
 721                Write_Indent_Str ("when ");
 722                Sprint_Node (Condition (Node));
 723                Write_Str (" => ");
 724                Indent_Annull;
 725             end if;
 726
 727             Sprint_Node_Sloc (Accept_Statement (Node));
 728             Sprint_Node_List (Statements (Node));
 729
 730          when N_Accept_Statement =>
 731             Write_Indent_Str_Sloc ("accept ");
 732             Write_Id (Entry_Direct_Name (Node));
 733
 734             if Present (Entry_Index (Node)) then
 735                Write_Str_With_Col_Check (" (");
 736                Sprint_Node (Entry_Index (Node));
 737                Write_Char (')');
 738             end if;
 739
 740             Write_Param_Specs (Node);
 741
 742             if Present (Handled_Statement_Sequence (Node)) then
 743                Write_Str_With_Col_Check (" do");
 744                Sprint_Node (Handled_Statement_Sequence (Node));
 745                Write_Indent_Str ("end ");
 746                Write_Id (Entry_Direct_Name (Node));
 747             end if;
 748
 749             Write_Char (';');
 750
 751          when N_Access_Definition =>
 752
 753             --  Ada 2005 (AI-254)
 754
 755             if Present (Access_To_Subprogram_Definition (Node)) then
 756                Sprint_Node (Access_To_Subprogram_Definition (Node));
 757             else
 758                --  Ada 2005 (AI-231)
 759
 760                if Null_Exclusion_Present (Node) then
 761                   Write_Str ("not null ");
 762                end if;
 763
 764                Write_Str_With_Col_Check_Sloc ("access ");
 765
 766                if All_Present (Node) then
 767                   Write_Str ("all ");
 768                elsif Constant_Present (Node) then
 769                   Write_Str ("constant ");
 770                end if;
 771
 772                Sprint_Node (Subtype_Mark (Node));
 773             end if;
 774
 775          when N_Access_Function_Definition =>
 776
 777             --  Ada 2005 (AI-231)
 778
 779             if Null_Exclusion_Present (Node) then
 780                Write_Str ("not null ");
 781             end if;
 782
 783             Write_Str_With_Col_Check_Sloc ("access ");
 784
 785             if Protected_Present (Node) then
 786                Write_Str_With_Col_Check ("protected ");
 787             end if;
 788
 789             Write_Str_With_Col_Check ("function");
 790             Write_Param_Specs (Node);
 791             Write_Str_With_Col_Check (" return ");
 792             Sprint_Node (Result_Definition (Node));
 793
 794          when N_Access_Procedure_Definition =>
 795
 796             --  Ada 2005 (AI-231)
 797
 798             if Null_Exclusion_Present (Node) then
 799                Write_Str ("not null ");
 800             end if;
 801
 802             Write_Str_With_Col_Check_Sloc ("access ");
 803
 804             if Protected_Present (Node) then
 805                Write_Str_With_Col_Check ("protected ");
 806             end if;
 807
 808             Write_Str_With_Col_Check ("procedure");
 809             Write_Param_Specs (Node);
 810
 811          when N_Access_To_Object_Definition =>
 812             Write_Str_With_Col_Check_Sloc ("access ");
 813
 814             if All_Present (Node) then
 815                Write_Str_With_Col_Check ("all ");
 816             elsif Constant_Present (Node) then
 817                Write_Str_With_Col_Check ("constant ");
 818             end if;
 819
 820             --  Ada 2005 (AI-231)
 821
 822             if Null_Exclusion_Present (Node) then
 823                Write_Str ("not null ");
 824             end if;
 825
 826             Sprint_Node (Subtype_Indication (Node));
 827
 828          when N_Aggregate =>
 829             if Null_Record_Present (Node) then
 830                Write_Str_With_Col_Check_Sloc ("(null record)");
 831
 832             else
 833                Write_Str_With_Col_Check_Sloc ("(");
 834
 835                if Present (Expressions (Node)) then
 836                   Sprint_Comma_List (Expressions (Node));
 837
 838                   if Present (Component_Associations (Node)) then
 839                      Write_Str (", ");
 840                   end if;
 841                end if;
 842
 843                if Present (Component_Associations (Node)) then
 844                   Indent_Begin;
 845
 846                   declare
 847                      Nd : Node_Id;
 848
 849                   begin
 850                      Nd := First (Component_Associations (Node));
 851
 852                      loop
 853                         Write_Indent;
 854                         Sprint_Node (Nd);
 855                         Next (Nd);
 856                         exit when No (Nd);
 857
 858                         if not Is_Rewrite_Insertion (Nd)
 859                           or else not Dump_Original_Only
 860                         then
 861                            Write_Str (", ");
 862                         end if;
 863                      end loop;
 864                   end;
 865
 866                   Indent_End;
 867                end if;
 868
 869                Write_Char (')');
 870             end if;
 871
 872          when N_Allocator =>
 873             Write_Str_With_Col_Check_Sloc ("new ");
 874
 875             --  Ada 2005 (AI-231)
 876
 877             if Null_Exclusion_Present (Node) then
 878                Write_Str ("not null ");
 879             end if;
 880
 881             Sprint_Node (Expression (Node));
 882
 883             if Present (Storage_Pool (Node)) then
 884                Write_Str_With_Col_Check ("[storage_pool = ");
 885                Sprint_Node (Storage_Pool (Node));
 886                Write_Char (']');
 887             end if;
 888
 889          when N_And_Then =>
 890             Sprint_Left_Opnd (Node);
 891             Write_Str_Sloc (" and then ");
 892             Sprint_Right_Opnd (Node);
 893
 894          when N_At_Clause =>
 895             Write_Indent_Str_Sloc ("for ");
 896             Write_Id (Identifier (Node));
 897             Write_Str_With_Col_Check (" use at ");
 898             Sprint_Node (Expression (Node));
 899             Write_Char (';');
 900
 901          when N_Assignment_Statement =>
 902             Write_Indent;
 903             Sprint_Node (Name (Node));
 904             Write_Str_Sloc (" := ");
 905             Sprint_Node (Expression (Node));
 906             Write_Char (';');
 907
 908          when N_Asynchronous_Select =>
 909             Write_Indent_Str_Sloc ("select");
 910             Indent_Begin;
 911             Sprint_Node (Triggering_Alternative (Node));
 912             Indent_End;
 913
 914             --  Note: let the printing of Abortable_Part handle outputting
 915             --  the ABORT keyword, so that the Slco can be set correctly.
 916
 917             Write_Indent_Str ("then ");
 918             Sprint_Node (Abortable_Part (Node));
 919             Write_Indent_Str ("end select;");
 920
 921          when N_Attribute_Definition_Clause =>
 922             Write_Indent_Str_Sloc ("for ");
 923             Sprint_Node (Name (Node));
 924             Write_Char (''');
 925             Write_Name_With_Col_Check (Chars (Node));
 926             Write_Str_With_Col_Check (" use ");
 927             Sprint_Node (Expression (Node));
 928             Write_Char (';');
 929
 930          when N_Attribute_Reference =>
 931             if Is_Procedure_Attribute_Name (Attribute_Name (Node)) then
 932                Write_Indent;
 933             end if;
 934
 935             Sprint_Node (Prefix (Node));
 936             Write_Char_Sloc (''');
 937             Write_Name_With_Col_Check (Attribute_Name (Node));
 938             Sprint_Paren_Comma_List (Expressions (Node));
 939
 940             if Is_Procedure_Attribute_Name (Attribute_Name (Node)) then
 941                Write_Char (';');
 942             end if;
 943
 944          when N_Block_Statement =>
 945             Write_Indent;
 946
 947             if Present (Identifier (Node))
 948               and then (not Has_Created_Identifier (Node)
 949                           or else not Dump_Original_Only)
 950             then
 951                Write_Rewrite_Str ("<<<");
 952                Write_Id (Identifier (Node));
 953                Write_Str (" : ");
 954                Write_Rewrite_Str (">>>");
 955             end if;
 956
 957             if Present (Declarations (Node)) then
 958                Write_Str_With_Col_Check_Sloc ("declare");
 959                Sprint_Indented_List (Declarations (Node));
 960                Write_Indent;
 961             end if;
 962
 963             Write_Str_With_Col_Check_Sloc ("begin");
 964             Sprint_Node (Handled_Statement_Sequence (Node));
 965             Write_Indent_Str ("end");
 966
 967             if Present (Identifier (Node))
 968               and then (not Has_Created_Identifier (Node)
 969                           or else not Dump_Original_Only)
 970             then
 971                Write_Rewrite_Str ("<<<");
 972                Write_Char (' ');
 973                Write_Id (Identifier (Node));
 974                Write_Rewrite_Str (">>>");
 975             end if;
 976
 977             Write_Char (';');
 978
 979          when N_Case_Statement =>
 980             Write_Indent_Str_Sloc ("case ");
 981             Sprint_Node (Expression (Node));
 982             Write_Str (" is");
 983             Sprint_Indented_List (Alternatives (Node));
 984             Write_Indent_Str ("end case;");
 985
 986          when N_Case_Statement_Alternative =>
 987             Write_Indent_Str_Sloc ("when ");
 988             Sprint_Bar_List (Discrete_Choices (Node));
 989             Write_Str (" => ");
 990             Sprint_Indented_List (Statements (Node));
 991
 992          when N_Character_Literal =>
 993             if Column > 70 then
 994                Write_Indent_Str ("  ");
 995             end if;
 996
 997             Write_Char_Sloc (''');
 998             Write_Char_Code (UI_To_CC (Char_Literal_Value (Node)));
 999             Write_Char (''');
1000
1001          when N_Code_Statement =>
1002             Write_Indent;
1003             Set_Debug_Sloc;
1004             Sprint_Node (Expression (Node));
1005             Write_Char (';');
1006
1007          when N_Compilation_Unit =>
1008             Sprint_Node_List (Context_Items (Node));
1009             Sprint_Opt_Node_List (Declarations (Aux_Decls_Node (Node)));
1010
1011             if Private_Present (Node) then
1012                Write_Indent_Str ("private ");
1013                Indent_Annull;
1014             end if;
1015
1016             Sprint_Node_Sloc (Unit (Node));
1017
1018             if Present (Actions (Aux_Decls_Node (Node)))
1019                  or else
1020                Present (Pragmas_After (Aux_Decls_Node (Node)))
1021             then
1022                Write_Indent;
1023             end if;
1024
1025             Sprint_Opt_Node_List (Actions (Aux_Decls_Node (Node)));
1026             Sprint_Opt_Node_List (Pragmas_After (Aux_Decls_Node (Node)));
1027
1028          when N_Compilation_Unit_Aux =>
1029             null; -- nothing to do, never used, see above
1030
1031          when N_Component_Association =>
1032             Set_Debug_Sloc;
1033             Sprint_Bar_List (Choices (Node));
1034             Write_Str (" => ");
1035
1036             --  Ada 2005 (AI-287): Print the box if present
1037
1038             if Box_Present (Node) then
1039                Write_Str_With_Col_Check ("<>");
1040             else
1041                Sprint_Node (Expression (Node));
1042             end if;
1043
1044          when N_Component_Clause =>
1045             Write_Indent;
1046             Sprint_Node (Component_Name (Node));
1047             Write_Str_Sloc (" at ");
1048             Sprint_Node (Position (Node));
1049             Write_Char (' ');
1050             Write_Str_With_Col_Check ("range ");
1051             Sprint_Node (First_Bit (Node));
1052             Write_Str (" .. ");
1053             Sprint_Node (Last_Bit (Node));
1054             Write_Char (';');
1055
1056          when N_Component_Definition =>
1057             Set_Debug_Sloc;
1058
1059             --  Ada 2005 (AI-230): Access definition components
1060
1061             if Present (Access_Definition (Node)) then
1062                Sprint_Node (Access_Definition (Node));
1063
1064             elsif Present (Subtype_Indication (Node)) then
1065                if Aliased_Present (Node) then
1066                   Write_Str_With_Col_Check ("aliased ");
1067                end if;
1068
1069                --  Ada 2005 (AI-231)
1070
1071                if Null_Exclusion_Present (Node) then
1072                   Write_Str (" not null ");
1073                end if;
1074
1075                Sprint_Node (Subtype_Indication (Node));
1076
1077             else
1078                Write_Str (" ??? ");
1079             end if;
1080
1081          when N_Component_Declaration =>
1082             if Write_Indent_Identifiers_Sloc (Node) then
1083                Write_Str (" : ");
1084                Sprint_Node (Component_Definition (Node));
1085
1086                if Present (Expression (Node)) then
1087                   Write_Str (" := ");
1088                   Sprint_Node (Expression (Node));
1089                end if;
1090
1091                Write_Char (';');
1092             end if;
1093
1094          when N_Component_List =>
1095             if Null_Present (Node) then
1096                Indent_Begin;
1097                Write_Indent_Str_Sloc ("null");
1098                Write_Char (';');
1099                Indent_End;
1100
1101             else
1102                Set_Debug_Sloc;
1103                Sprint_Indented_List (Component_Items (Node));
1104                Sprint_Node (Variant_Part (Node));
1105             end if;
1106
1107          when N_Conditional_Entry_Call =>
1108             Write_Indent_Str_Sloc ("select");
1109             Indent_Begin;
1110             Sprint_Node (Entry_Call_Alternative (Node));
1111             Indent_End;
1112             Write_Indent_Str ("else");
1113             Sprint_Indented_List (Else_Statements (Node));
1114             Write_Indent_Str ("end select;");
1115
1116          when N_Conditional_Expression =>
1117             declare
1118                Condition : constant Node_Id := First (Expressions (Node));
1119                Then_Expr : constant Node_Id := Next (Condition);
1120                Else_Expr : constant Node_Id := Next (Then_Expr);
1121             begin
1122                Write_Str_With_Col_Check_Sloc ("(if ");
1123                Sprint_Node (Condition);
1124                Write_Str_With_Col_Check (" then ");
1125                Sprint_Node (Then_Expr);
1126                Write_Str_With_Col_Check (" else ");
1127                Sprint_Node (Else_Expr);
1128                Write_Char (')');
1129             end;
1130
1131          when N_Constrained_Array_Definition =>
1132             Write_Str_With_Col_Check_Sloc ("array ");
1133             Sprint_Paren_Comma_List (Discrete_Subtype_Definitions (Node));
1134             Write_Str (" of ");
1135
1136             Sprint_Node (Component_Definition (Node));
1137
1138          when N_Decimal_Fixed_Point_Definition =>
1139             Write_Str_With_Col_Check_Sloc (" delta ");
1140             Sprint_Node (Delta_Expression (Node));
1141             Write_Str_With_Col_Check ("digits ");
1142             Sprint_Node (Digits_Expression (Node));
1143             Sprint_Opt_Node (Real_Range_Specification (Node));
1144
1145          when N_Defining_Character_Literal =>
1146             Write_Name_With_Col_Check_Sloc (Chars (Node));
1147
1148          when N_Defining_Identifier =>
1149             Set_Debug_Sloc;
1150             Write_Id (Node);
1151
1152          when N_Defining_Operator_Symbol =>
1153             Write_Name_With_Col_Check_Sloc (Chars (Node));
1154
1155          when N_Defining_Program_Unit_Name =>
1156             Set_Debug_Sloc;
1157             Sprint_Node (Name (Node));
1158             Write_Char ('.');
1159             Write_Id (Defining_Identifier (Node));
1160
1161          when N_Delay_Alternative =>
1162             Sprint_Node_List (Pragmas_Before (Node));
1163
1164             if Present (Condition (Node)) then
1165                Write_Indent;
1166                Write_Str_With_Col_Check ("when ");
1167                Sprint_Node (Condition (Node));
1168                Write_Str (" => ");
1169                Indent_Annull;
1170             end if;
1171
1172             Sprint_Node_Sloc (Delay_Statement (Node));
1173             Sprint_Node_List (Statements (Node));
1174
1175          when N_Delay_Relative_Statement =>
1176             Write_Indent_Str_Sloc ("delay ");
1177             Sprint_Node (Expression (Node));
1178             Write_Char (';');
1179
1180          when N_Delay_Until_Statement =>
1181             Write_Indent_Str_Sloc ("delay until ");
1182             Sprint_Node (Expression (Node));
1183             Write_Char (';');
1184
1185          when N_Delta_Constraint =>
1186             Write_Str_With_Col_Check_Sloc ("delta ");
1187             Sprint_Node (Delta_Expression (Node));
1188             Sprint_Opt_Node (Range_Constraint (Node));
1189
1190          when N_Derived_Type_Definition =>
1191             if Abstract_Present (Node) then
1192                Write_Str_With_Col_Check ("abstract ");
1193             end if;
1194
1195             Write_Str_With_Col_Check_Sloc ("new ");
1196
1197             --  Ada 2005 (AI-231)
1198
1199             if Null_Exclusion_Present (Node) then
1200                Write_Str_With_Col_Check ("not null ");
1201             end if;
1202
1203             Sprint_Node (Subtype_Indication (Node));
1204
1205             if Present (Interface_List (Node)) then
1206                Sprint_And_List (Interface_List (Node));
1207                Write_Str_With_Col_Check (" with ");
1208             end if;
1209
1210             if Present (Record_Extension_Part (Node)) then
1211                if No (Interface_List (Node)) then
1212                   Write_Str_With_Col_Check (" with ");
1213                end if;
1214
1215                Sprint_Node (Record_Extension_Part (Node));
1216             end if;
1217
1218          when N_Designator =>
1219             Sprint_Node (Name (Node));
1220             Write_Char_Sloc ('.');
1221             Write_Id (Identifier (Node));
1222
1223          when N_Digits_Constraint =>
1224             Write_Str_With_Col_Check_Sloc ("digits ");
1225             Sprint_Node (Digits_Expression (Node));
1226             Sprint_Opt_Node (Range_Constraint (Node));
1227
1228          when N_Discriminant_Association =>
1229             Set_Debug_Sloc;
1230
1231             if Present (Selector_Names (Node)) then
1232                Sprint_Bar_List (Selector_Names (Node));
1233                Write_Str (" => ");
1234             end if;
1235
1236             Set_Debug_Sloc;
1237             Sprint_Node (Expression (Node));
1238
1239          when N_Discriminant_Specification =>
1240             Set_Debug_Sloc;
1241
1242             if Write_Identifiers (Node) then
1243                Write_Str (" : ");
1244
1245                if Null_Exclusion_Present (Node) then
1246                   Write_Str ("not null ");
1247                end if;
1248
1249                Sprint_Node (Discriminant_Type (Node));
1250
1251                if Present (Expression (Node)) then
1252                   Write_Str (" := ");
1253                   Sprint_Node (Expression (Node));
1254                end if;
1255             else
1256                Write_Str (", ");
1257             end if;
1258
1259          when N_Elsif_Part =>
1260             Write_Indent_Str_Sloc ("elsif ");
1261             Sprint_Node (Condition (Node));
1262             Write_Str_With_Col_Check (" then");
1263             Sprint_Indented_List (Then_Statements (Node));
1264
1265          when N_Empty =>
1266             null;
1267
1268          when N_Entry_Body =>
1269             Write_Indent_Str_Sloc ("entry ");
1270             Write_Id (Defining_Identifier (Node));
1271             Sprint_Node (Entry_Body_Formal_Part (Node));
1272             Write_Str_With_Col_Check (" is");
1273             Sprint_Indented_List (Declarations (Node));
1274             Write_Indent_Str ("begin");
1275             Sprint_Node (Handled_Statement_Sequence (Node));
1276             Write_Indent_Str ("end ");
1277             Write_Id (Defining_Identifier (Node));
1278             Write_Char (';');
1279
1280          when N_Entry_Body_Formal_Part =>
1281             if Present (Entry_Index_Specification (Node)) then
1282                Write_Str_With_Col_Check_Sloc (" (");
1283                Sprint_Node (Entry_Index_Specification (Node));
1284                Write_Char (')');
1285             end if;
1286
1287             Write_Param_Specs (Node);
1288             Write_Str_With_Col_Check_Sloc (" when ");
1289             Sprint_Node (Condition (Node));
1290
1291          when N_Entry_Call_Alternative =>
1292             Sprint_Node_List (Pragmas_Before (Node));
1293             Sprint_Node_Sloc (Entry_Call_Statement (Node));
1294             Sprint_Node_List (Statements (Node));
1295
1296          when N_Entry_Call_Statement =>
1297             Write_Indent;
1298             Sprint_Node_Sloc (Name (Node));
1299             Sprint_Opt_Paren_Comma_List (Parameter_Associations (Node));
1300             Write_Char (';');
1301
1302          when N_Entry_Declaration =>
1303             Write_Indent_Str_Sloc ("entry ");
1304             Write_Id (Defining_Identifier (Node));
1305
1306             if Present (Discrete_Subtype_Definition (Node)) then
1307                Write_Str_With_Col_Check (" (");
1308                Sprint_Node (Discrete_Subtype_Definition (Node));
1309                Write_Char (')');
1310             end if;
1311
1312             Write_Param_Specs (Node);
1313             Write_Char (';');
1314
1315          when N_Entry_Index_Specification =>
1316             Write_Str_With_Col_Check_Sloc ("for ");
1317             Write_Id (Defining_Identifier (Node));
1318             Write_Str_With_Col_Check (" in ");
1319             Sprint_Node (Discrete_Subtype_Definition (Node));
1320
1321          when N_Enumeration_Representation_Clause =>
1322             Write_Indent_Str_Sloc ("for ");
1323             Write_Id (Identifier (Node));
1324             Write_Str_With_Col_Check (" use ");
1325             Sprint_Node (Array_Aggregate (Node));
1326             Write_Char (';');
1327
1328          when N_Enumeration_Type_Definition =>
1329             Set_Debug_Sloc;
1330
1331             --  Skip attempt to print Literals field if it's not there and
1332             --  we are in package Standard (case of Character, which is
1333             --  handled specially (without an explicit literals list).
1334
1335             if Sloc (Node) > Standard_Location
1336               or else Present (Literals (Node))
1337             then
1338                Sprint_Paren_Comma_List (Literals (Node));
1339             end if;
1340
1341          when N_Error =>
1342             Write_Str_With_Col_Check_Sloc ("<error>");
1343
1344          when N_Exception_Declaration =>
1345             if Write_Indent_Identifiers (Node) then
1346                Write_Str_With_Col_Check (" : ");
1347                Write_Str_Sloc ("exception;");
1348             end if;
1349
1350          when N_Exception_Handler =>
1351             Write_Indent_Str_Sloc ("when ");
1352
1353             if Present (Choice_Parameter (Node)) then
1354                Sprint_Node (Choice_Parameter (Node));
1355                Write_Str (" : ");
1356             end if;
1357
1358             Sprint_Bar_List (Exception_Choices (Node));
1359             Write_Str (" => ");
1360             Sprint_Indented_List (Statements (Node));
1361
1362          when N_Exception_Renaming_Declaration =>
1363             Write_Indent;
1364             Set_Debug_Sloc;
1365             Sprint_Node (Defining_Identifier (Node));
1366             Write_Str_With_Col_Check (" : exception renames ");
1367             Sprint_Node (Name (Node));
1368             Write_Char (';');
1369
1370          when N_Exit_Statement =>
1371             Write_Indent_Str_Sloc ("exit");
1372             Sprint_Opt_Node (Name (Node));
1373
1374             if Present (Condition (Node)) then
1375                Write_Str_With_Col_Check (" when ");
1376                Sprint_Node (Condition (Node));
1377             end if;
1378
1379             Write_Char (';');
1380
1381          when N_Expanded_Name =>
1382             Sprint_Node (Prefix (Node));
1383             Write_Char_Sloc ('.');
1384             Sprint_Node (Selector_Name (Node));
1385
1386          when N_Explicit_Dereference =>
1387             Sprint_Node (Prefix (Node));
1388             Write_Char_Sloc ('.');
1389             Write_Str_Sloc ("all");
1390
1391          when N_Extension_Aggregate =>
1392             Write_Str_With_Col_Check_Sloc ("(");
1393             Sprint_Node (Ancestor_Part (Node));
1394             Write_Str_With_Col_Check (" with ");
1395
1396             if Null_Record_Present (Node) then
1397                Write_Str_With_Col_Check ("null record");
1398             else
1399                if Present (Expressions (Node)) then
1400                   Sprint_Comma_List (Expressions (Node));
1401
1402                   if Present (Component_Associations (Node)) then
1403                      Write_Str (", ");
1404                   end if;
1405                end if;
1406
1407                if Present (Component_Associations (Node)) then
1408                   Sprint_Comma_List (Component_Associations (Node));
1409                end if;
1410             end if;
1411
1412             Write_Char (')');
1413
1414          when N_Floating_Point_Definition =>
1415             Write_Str_With_Col_Check_Sloc ("digits ");
1416             Sprint_Node (Digits_Expression (Node));
1417             Sprint_Opt_Node (Real_Range_Specification (Node));
1418
1419          when N_Formal_Decimal_Fixed_Point_Definition =>
1420             Write_Str_With_Col_Check_Sloc ("delta <> digits <>");
1421
1422          when N_Formal_Derived_Type_Definition =>
1423             Write_Str_With_Col_Check_Sloc ("new ");
1424             Sprint_Node (Subtype_Mark (Node));
1425
1426             if Private_Present (Node) then
1427                Write_Str_With_Col_Check (" with private");
1428             end if;
1429
1430          when N_Formal_Abstract_Subprogram_Declaration =>
1431             Write_Indent_Str_Sloc ("with ");
1432             Sprint_Node (Specification (Node));
1433
1434             Write_Str_With_Col_Check (" is abstract");
1435
1436             if Box_Present (Node) then
1437                Write_Str_With_Col_Check (" <>");
1438             elsif Present (Default_Name (Node)) then
1439                Write_Str_With_Col_Check (" ");
1440                Sprint_Node (Default_Name (Node));
1441             end if;
1442
1443             Write_Char (';');
1444
1445          when N_Formal_Concrete_Subprogram_Declaration =>
1446             Write_Indent_Str_Sloc ("with ");
1447             Sprint_Node (Specification (Node));
1448
1449             if Box_Present (Node) then
1450                Write_Str_With_Col_Check (" is <>");
1451             elsif Present (Default_Name (Node)) then
1452                Write_Str_With_Col_Check (" is ");
1453                Sprint_Node (Default_Name (Node));
1454             end if;
1455
1456             Write_Char (';');
1457
1458          when N_Formal_Discrete_Type_Definition =>
1459             Write_Str_With_Col_Check_Sloc ("<>");
1460
1461          when N_Formal_Floating_Point_Definition =>
1462             Write_Str_With_Col_Check_Sloc ("digits <>");
1463
1464          when N_Formal_Modular_Type_Definition =>
1465             Write_Str_With_Col_Check_Sloc ("mod <>");
1466
1467          when N_Formal_Object_Declaration =>
1468             Set_Debug_Sloc;
1469
1470             if Write_Indent_Identifiers (Node) then
1471                Write_Str (" : ");
1472
1473                if In_Present (Node) then
1474                   Write_Str_With_Col_Check ("in ");
1475                end if;
1476
1477                if Out_Present (Node) then
1478                   Write_Str_With_Col_Check ("out ");
1479                end if;
1480
1481                Sprint_Node (Subtype_Mark (Node));
1482
1483                if Present (Expression (Node)) then
1484                   Write_Str (" := ");
1485                   Sprint_Node (Expression (Node));
1486                end if;
1487
1488                Write_Char (';');
1489             end if;
1490
1491          when N_Formal_Ordinary_Fixed_Point_Definition =>
1492             Write_Str_With_Col_Check_Sloc ("delta <>");
1493
1494          when N_Formal_Package_Declaration =>
1495             Write_Indent_Str_Sloc ("with package ");
1496             Write_Id (Defining_Identifier (Node));
1497             Write_Str_With_Col_Check (" is new ");
1498             Sprint_Node (Name (Node));
1499             Write_Str_With_Col_Check (" (<>);");
1500
1501          when N_Formal_Private_Type_Definition =>
1502             if Abstract_Present (Node) then
1503                Write_Str_With_Col_Check ("abstract ");
1504             end if;
1505
1506             if Tagged_Present (Node) then
1507                Write_Str_With_Col_Check ("tagged ");
1508             end if;
1509
1510             if Limited_Present (Node) then
1511                Write_Str_With_Col_Check ("limited ");
1512             end if;
1513
1514             Write_Str_With_Col_Check_Sloc ("private");
1515
1516          when N_Formal_Signed_Integer_Type_Definition =>
1517             Write_Str_With_Col_Check_Sloc ("range <>");
1518
1519          when N_Formal_Type_Declaration =>
1520             Write_Indent_Str_Sloc ("type ");
1521             Write_Id (Defining_Identifier (Node));
1522
1523             if Present (Discriminant_Specifications (Node)) then
1524                Write_Discr_Specs (Node);
1525             elsif Unknown_Discriminants_Present (Node) then
1526                Write_Str_With_Col_Check ("(<>)");
1527             end if;
1528
1529             Write_Str_With_Col_Check (" is ");
1530             Sprint_Node (Formal_Type_Definition (Node));
1531             Write_Char (';');
1532
1533          when N_Free_Statement =>
1534             Write_Indent_Str_Sloc ("free ");
1535             Sprint_Node (Expression (Node));
1536             Write_Char (';');
1537
1538          when N_Freeze_Entity =>
1539             if Dump_Original_Only then
1540                null;
1541
1542             elsif Present (Actions (Node)) or else Dump_Freeze_Null then
1543                Write_Indent;
1544                Write_Rewrite_Str ("<<<");
1545                Write_Str_With_Col_Check_Sloc ("freeze ");
1546                Write_Id (Entity (Node));
1547                Write_Str (" [");
1548
1549                if No (Actions (Node)) then
1550                   Write_Char (']');
1551
1552                else
1553                   Freeze_Indent := Freeze_Indent + 1;
1554                   Sprint_Indented_List (Actions (Node));
1555                   Freeze_Indent := Freeze_Indent - 1;
1556                   Write_Indent_Str ("]");
1557                end if;
1558
1559                Write_Rewrite_Str (">>>");
1560             end if;
1561
1562          when N_Full_Type_Declaration =>
1563             Write_Indent_Str_Sloc ("type ");
1564             Write_Id (Defining_Identifier (Node));
1565             Write_Discr_Specs (Node);
1566             Write_Str_With_Col_Check (" is ");
1567             Sprint_Node (Type_Definition (Node));
1568             Write_Char (';');
1569
1570          when N_Function_Call =>
1571             Set_Debug_Sloc;
1572             Note_Implicit_Run_Time_Call (Name (Node));
1573             Sprint_Node (Name (Node));
1574             Sprint_Opt_Paren_Comma_List (Parameter_Associations (Node));
1575
1576          when N_Function_Instantiation =>
1577             Write_Indent_Str_Sloc ("function ");
1578             Sprint_Node (Defining_Unit_Name (Node));
1579             Write_Str_With_Col_Check (" is new ");
1580             Sprint_Node (Name (Node));
1581             Sprint_Opt_Paren_Comma_List (Generic_Associations (Node));
1582             Write_Char (';');
1583
1584          when N_Function_Specification =>
1585             Write_Str_With_Col_Check_Sloc ("function ");
1586             Sprint_Node (Defining_Unit_Name (Node));
1587             Write_Param_Specs (Node);
1588             Write_Str_With_Col_Check (" return ");
1589
1590             --  Ada 2005 (AI-231)
1591
1592             if Nkind (Result_Definition (Node)) /= N_Access_Definition
1593               and then Null_Exclusion_Present (Node)
1594             then
1595                Write_Str (" not null ");
1596             end if;
1597
1598             Sprint_Node (Result_Definition (Node));
1599
1600          when N_Generic_Association =>
1601             Set_Debug_Sloc;
1602
1603             if Present (Selector_Name (Node)) then
1604                Sprint_Node (Selector_Name (Node));
1605                Write_Str (" => ");
1606             end if;
1607
1608             Sprint_Node (Explicit_Generic_Actual_Parameter (Node));
1609
1610          when N_Generic_Function_Renaming_Declaration =>
1611             Write_Indent_Str_Sloc ("generic function ");
1612             Sprint_Node (Defining_Unit_Name (Node));
1613             Write_Str_With_Col_Check (" renames ");
1614             Sprint_Node (Name (Node));
1615             Write_Char (';');
1616
1617          when N_Generic_Package_Declaration =>
1618             Write_Indent;
1619             Write_Indent_Str_Sloc ("generic ");
1620             Sprint_Indented_List (Generic_Formal_Declarations (Node));
1621             Write_Indent;
1622             Sprint_Node (Specification (Node));
1623             Write_Char (';');
1624
1625          when N_Generic_Package_Renaming_Declaration =>
1626             Write_Indent_Str_Sloc ("generic package ");
1627             Sprint_Node (Defining_Unit_Name (Node));
1628             Write_Str_With_Col_Check (" renames ");
1629             Sprint_Node (Name (Node));
1630             Write_Char (';');
1631
1632          when N_Generic_Procedure_Renaming_Declaration =>
1633             Write_Indent_Str_Sloc ("generic procedure ");
1634             Sprint_Node (Defining_Unit_Name (Node));
1635             Write_Str_With_Col_Check (" renames ");
1636             Sprint_Node (Name (Node));
1637             Write_Char (';');
1638
1639          when N_Generic_Subprogram_Declaration =>
1640             Write_Indent;
1641             Write_Indent_Str_Sloc ("generic ");
1642             Sprint_Indented_List (Generic_Formal_Declarations (Node));
1643             Write_Indent;
1644             Sprint_Node (Specification (Node));
1645             Write_Char (';');
1646
1647          when N_Goto_Statement =>
1648             Write_Indent_Str_Sloc ("goto ");
1649             Sprint_Node (Name (Node));
1650             Write_Char (';');
1651
1652             if Nkind (Next (Node)) = N_Label then
1653                Write_Indent;
1654             end if;
1655
1656          when N_Handled_Sequence_Of_Statements =>
1657             Set_Debug_Sloc;
1658             Sprint_Indented_List (Statements (Node));
1659
1660             if Present (Exception_Handlers (Node)) then
1661                Write_Indent_Str ("exception");
1662                Indent_Begin;
1663                Sprint_Node_List (Exception_Handlers (Node));
1664                Indent_End;
1665             end if;
1666
1667             if Present (At_End_Proc (Node)) then
1668                Write_Indent_Str ("at end");
1669                Indent_Begin;
1670                Write_Indent;
1671                Sprint_Node (At_End_Proc (Node));
1672                Write_Char (';');
1673                Indent_End;
1674             end if;
1675
1676          when N_Identifier =>
1677             Set_Debug_Sloc;
1678             Write_Id (Node);
1679
1680          when N_If_Statement =>
1681             Write_Indent_Str_Sloc ("if ");
1682             Sprint_Node (Condition (Node));
1683             Write_Str_With_Col_Check (" then");
1684             Sprint_Indented_List (Then_Statements (Node));
1685             Sprint_Opt_Node_List (Elsif_Parts (Node));
1686
1687             if Present (Else_Statements (Node)) then
1688                Write_Indent_Str ("else");
1689                Sprint_Indented_List (Else_Statements (Node));
1690             end if;
1691
1692             Write_Indent_Str ("end if;");
1693
1694          when N_Implicit_Label_Declaration =>
1695             if not Dump_Original_Only then
1696                Write_Indent;
1697                Write_Rewrite_Str ("<<<");
1698                Set_Debug_Sloc;
1699                Write_Id (Defining_Identifier (Node));
1700                Write_Str (" : ");
1701                Write_Str_With_Col_Check ("label");
1702                Write_Rewrite_Str (">>>");
1703             end if;
1704
1705          when N_In =>
1706             Sprint_Left_Opnd (Node);
1707             Write_Str_Sloc (" in ");
1708             Sprint_Right_Opnd (Node);
1709
1710          when N_Incomplete_Type_Declaration =>
1711             Write_Indent_Str_Sloc ("type ");
1712             Write_Id (Defining_Identifier (Node));
1713
1714             if Present (Discriminant_Specifications (Node)) then
1715                Write_Discr_Specs (Node);
1716             elsif Unknown_Discriminants_Present (Node) then
1717                Write_Str_With_Col_Check ("(<>)");
1718             end if;
1719
1720             Write_Char (';');
1721
1722          when N_Index_Or_Discriminant_Constraint =>
1723             Set_Debug_Sloc;
1724             Sprint_Paren_Comma_List (Constraints (Node));
1725
1726          when N_Indexed_Component =>
1727             Sprint_Node_Sloc (Prefix (Node));
1728             Sprint_Opt_Paren_Comma_List (Expressions (Node));
1729
1730          when N_Integer_Literal =>
1731             if Print_In_Hex (Node) then
1732                Write_Uint_With_Col_Check_Sloc (Intval (Node), Hex);
1733             else
1734                Write_Uint_With_Col_Check_Sloc (Intval (Node), Auto);
1735             end if;
1736
1737          when N_Iteration_Scheme =>
1738             if Present (Condition (Node)) then
1739                Write_Str_With_Col_Check_Sloc ("while ");
1740                Sprint_Node (Condition (Node));
1741             else
1742                Write_Str_With_Col_Check_Sloc ("for ");
1743                Sprint_Node (Loop_Parameter_Specification (Node));
1744             end if;
1745
1746             Write_Char (' ');
1747
1748          when N_Itype_Reference =>
1749             Write_Indent_Str_Sloc ("reference ");
1750             Write_Id (Itype (Node));
1751
1752          when N_Label =>
1753             Write_Indent_Str_Sloc ("<<");
1754             Write_Id (Identifier (Node));
1755             Write_Str (">>");
1756
1757          when N_Loop_Parameter_Specification =>
1758             Set_Debug_Sloc;
1759             Write_Id (Defining_Identifier (Node));
1760             Write_Str_With_Col_Check (" in ");
1761
1762             if Reverse_Present (Node) then
1763                Write_Str_With_Col_Check ("reverse ");
1764             end if;
1765
1766             Sprint_Node (Discrete_Subtype_Definition (Node));
1767
1768          when N_Loop_Statement =>
1769             Write_Indent;
1770
1771             if Present (Identifier (Node))
1772               and then (not Has_Created_Identifier (Node)
1773                           or else not Dump_Original_Only)
1774             then
1775                Write_Rewrite_Str ("<<<");
1776                Write_Id (Identifier (Node));
1777                Write_Str (" : ");
1778                Write_Rewrite_Str (">>>");
1779                Sprint_Node (Iteration_Scheme (Node));
1780                Write_Str_With_Col_Check_Sloc ("loop");
1781                Sprint_Indented_List (Statements (Node));
1782                Write_Indent_Str ("end loop ");
1783                Write_Rewrite_Str ("<<<");
1784                Write_Id (Identifier (Node));
1785                Write_Rewrite_Str (">>>");
1786                Write_Char (';');
1787
1788             else
1789                Sprint_Node (Iteration_Scheme (Node));
1790                Write_Str_With_Col_Check_Sloc ("loop");
1791                Sprint_Indented_List (Statements (Node));
1792                Write_Indent_Str ("end loop;");
1793             end if;
1794
1795          when N_Mod_Clause =>
1796             Sprint_Node_List (Pragmas_Before (Node));
1797             Write_Str_With_Col_Check_Sloc ("at mod ");
1798             Sprint_Node (Expression (Node));
1799
1800          when N_Modular_Type_Definition =>
1801             Write_Str_With_Col_Check_Sloc ("mod ");
1802             Sprint_Node (Expression (Node));
1803
1804          when N_Not_In =>
1805             Sprint_Left_Opnd (Node);
1806             Write_Str_Sloc (" not in ");
1807             Sprint_Right_Opnd (Node);
1808
1809          when N_Null =>
1810             Write_Str_With_Col_Check_Sloc ("null");
1811
1812          when N_Null_Statement =>
1813             if Comes_From_Source (Node)
1814               or else Dump_Freeze_Null
1815               or else not Is_List_Member (Node)
1816               or else (No (Prev (Node)) and then No (Next (Node)))
1817             then
1818                Write_Indent_Str_Sloc ("null;");
1819             end if;
1820
1821          when N_Number_Declaration =>
1822             Set_Debug_Sloc;
1823
1824             if Write_Indent_Identifiers (Node) then
1825                Write_Str_With_Col_Check (" : constant ");
1826                Write_Str (" := ");
1827                Sprint_Node (Expression (Node));
1828                Write_Char (';');
1829             end if;
1830
1831          when N_Object_Declaration =>
1832             Set_Debug_Sloc;
1833
1834             if Write_Indent_Identifiers (Node) then
1835                Write_Str (" : ");
1836
1837                if Aliased_Present (Node) then
1838                   Write_Str_With_Col_Check ("aliased ");
1839                end if;
1840
1841                if Constant_Present (Node) then
1842                   Write_Str_With_Col_Check ("constant ");
1843                end if;
1844
1845                --  Ada 2005 (AI-231)
1846
1847                if Null_Exclusion_Present (Node) then
1848                   Write_Str_With_Col_Check ("not null ");
1849                end if;
1850
1851                Sprint_Node (Object_Definition (Node));
1852
1853                if Present (Expression (Node)) then
1854                   Write_Str (" := ");
1855                   Sprint_Node (Expression (Node));
1856                end if;
1857
1858                Write_Char (';');
1859             end if;
1860
1861          when N_Object_Renaming_Declaration =>
1862             Write_Indent;
1863             Set_Debug_Sloc;
1864             Sprint_Node (Defining_Identifier (Node));
1865             Write_Str (" : ");
1866
1867             --  Ada 2005 (AI-230): Access renamings
1868
1869             if Present (Access_Definition (Node)) then
1870                Sprint_Node (Access_Definition (Node));
1871
1872             elsif Present (Subtype_Mark (Node)) then
1873                Sprint_Node (Subtype_Mark (Node));
1874
1875             else
1876                Write_Str (" ??? ");
1877             end if;
1878
1879             Write_Str_With_Col_Check (" renames ");
1880             Sprint_Node (Name (Node));
1881             Write_Char (';');
1882
1883          when N_Op_Abs =>
1884             Write_Operator (Node, "abs ");
1885             Sprint_Right_Opnd (Node);
1886
1887          when N_Op_Add =>
1888             Sprint_Left_Opnd (Node);
1889             Write_Operator (Node, " + ");
1890             Sprint_Right_Opnd (Node);
1891
1892          when N_Op_And =>
1893             Sprint_Left_Opnd (Node);
1894             Write_Operator (Node, " and ");
1895             Sprint_Right_Opnd (Node);
1896
1897          when N_Op_Concat =>
1898             Sprint_Left_Opnd (Node);
1899             Write_Operator (Node, " & ");
1900             Sprint_Right_Opnd (Node);
1901
1902          when N_Op_Divide =>
1903             Sprint_Left_Opnd (Node);
1904             Write_Char (' ');
1905             Process_TFAI_RR_Flags (Node);
1906             Write_Operator (Node, "/ ");
1907             Sprint_Right_Opnd (Node);
1908
1909          when N_Op_Eq =>
1910             Sprint_Left_Opnd (Node);
1911             Write_Operator (Node, " = ");
1912             Sprint_Right_Opnd (Node);
1913
1914          when N_Op_Expon =>
1915             Sprint_Left_Opnd (Node);
1916             Write_Operator (Node, " ** ");
1917             Sprint_Right_Opnd (Node);
1918
1919          when N_Op_Ge =>
1920             Sprint_Left_Opnd (Node);
1921             Write_Operator (Node, " >= ");
1922             Sprint_Right_Opnd (Node);
1923
1924          when N_Op_Gt =>
1925             Sprint_Left_Opnd (Node);
1926             Write_Operator (Node, " > ");
1927             Sprint_Right_Opnd (Node);
1928
1929          when N_Op_Le =>
1930             Sprint_Left_Opnd (Node);
1931             Write_Operator (Node, " <= ");
1932             Sprint_Right_Opnd (Node);
1933
1934          when N_Op_Lt =>
1935             Sprint_Left_Opnd (Node);
1936             Write_Operator (Node, " < ");
1937             Sprint_Right_Opnd (Node);
1938
1939          when N_Op_Minus =>
1940             Write_Operator (Node, "-");
1941             Sprint_Right_Opnd (Node);
1942
1943          when N_Op_Mod =>
1944             Sprint_Left_Opnd (Node);
1945
1946             if Treat_Fixed_As_Integer (Node) then
1947                Write_Str (" #");
1948             end if;
1949
1950             Write_Operator (Node, " mod ");
1951             Sprint_Right_Opnd (Node);
1952
1953          when N_Op_Multiply =>
1954             Sprint_Left_Opnd (Node);
1955             Write_Char (' ');
1956             Process_TFAI_RR_Flags (Node);
1957             Write_Operator (Node, "* ");
1958             Sprint_Right_Opnd (Node);
1959
1960          when N_Op_Ne =>
1961             Sprint_Left_Opnd (Node);
1962             Write_Operator (Node, " /= ");
1963             Sprint_Right_Opnd (Node);
1964
1965          when N_Op_Not =>
1966             Write_Operator (Node, "not ");
1967             Sprint_Right_Opnd (Node);
1968
1969          when N_Op_Or =>
1970             Sprint_Left_Opnd (Node);
1971             Write_Operator (Node, " or ");
1972             Sprint_Right_Opnd (Node);
1973
1974          when N_Op_Plus =>
1975             Write_Operator (Node, "+");
1976             Sprint_Right_Opnd (Node);
1977
1978          when N_Op_Rem =>
1979             Sprint_Left_Opnd (Node);
1980
1981             if Treat_Fixed_As_Integer (Node) then
1982                Write_Str (" #");
1983             end if;
1984
1985             Write_Operator (Node, " rem ");
1986             Sprint_Right_Opnd (Node);
1987
1988          when N_Op_Shift =>
1989             Set_Debug_Sloc;
1990             Write_Id (Node);
1991             Write_Char ('!');
1992             Write_Str_With_Col_Check ("(");
1993             Sprint_Node (Left_Opnd (Node));
1994             Write_Str (", ");
1995             Sprint_Node (Right_Opnd (Node));
1996             Write_Char (')');
1997
1998          when N_Op_Subtract =>
1999             Sprint_Left_Opnd (Node);
2000             Write_Operator (Node, " - ");
2001             Sprint_Right_Opnd (Node);
2002
2003          when N_Op_Xor =>
2004             Sprint_Left_Opnd (Node);
2005             Write_Operator (Node, " xor ");
2006             Sprint_Right_Opnd (Node);
2007
2008          when N_Operator_Symbol =>
2009             Write_Name_With_Col_Check_Sloc (Chars (Node));
2010
2011          when N_Ordinary_Fixed_Point_Definition =>
2012             Write_Str_With_Col_Check_Sloc ("delta ");
2013             Sprint_Node (Delta_Expression (Node));
2014             Sprint_Opt_Node (Real_Range_Specification (Node));
2015
2016          when N_Or_Else =>
2017             Sprint_Left_Opnd (Node);
2018             Write_Str_Sloc (" or else ");
2019             Sprint_Right_Opnd (Node);
2020
2021          when N_Others_Choice =>
2022             if All_Others (Node) then
2023                Write_Str_With_Col_Check ("all ");
2024             end if;
2025
2026             Write_Str_With_Col_Check_Sloc ("others");
2027
2028          when N_Package_Body =>
2029             Write_Indent;
2030             Write_Indent_Str_Sloc ("package body ");
2031             Sprint_Node (Defining_Unit_Name (Node));
2032             Write_Str (" is");
2033             Sprint_Indented_List (Declarations (Node));
2034
2035             if Present (Handled_Statement_Sequence (Node)) then
2036                Write_Indent_Str ("begin");
2037                Sprint_Node (Handled_Statement_Sequence (Node));
2038             end if;
2039
2040             Write_Indent_Str ("end ");
2041             Sprint_Node (Defining_Unit_Name (Node));
2042             Write_Char (';');
2043
2044          when N_Package_Body_Stub =>
2045             Write_Indent_Str_Sloc ("package body ");
2046             Sprint_Node (Defining_Identifier (Node));
2047             Write_Str_With_Col_Check (" is separate;");
2048
2049          when N_Package_Declaration =>
2050             Write_Indent;
2051             Write_Indent;
2052             Sprint_Node_Sloc (Specification (Node));
2053             Write_Char (';');
2054
2055          when N_Package_Instantiation =>
2056             Write_Indent;
2057             Write_Indent_Str_Sloc ("package ");
2058             Sprint_Node (Defining_Unit_Name (Node));
2059             Write_Str (" is new ");
2060             Sprint_Node (Name (Node));
2061             Sprint_Opt_Paren_Comma_List (Generic_Associations (Node));
2062             Write_Char (';');
2063
2064          when N_Package_Renaming_Declaration =>
2065             Write_Indent_Str_Sloc ("package ");
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_Package_Specification =>
2072             Write_Str_With_Col_Check_Sloc ("package ");
2073             Sprint_Node (Defining_Unit_Name (Node));
2074             Write_Str (" is");
2075             Sprint_Indented_List (Visible_Declarations (Node));
2076
2077             if Present (Private_Declarations (Node)) then
2078                Write_Indent_Str ("private");
2079                Sprint_Indented_List (Private_Declarations (Node));
2080             end if;
2081
2082             Write_Indent_Str ("end ");
2083             Sprint_Node (Defining_Unit_Name (Node));
2084
2085          when N_Parameter_Association =>
2086             Sprint_Node_Sloc (Selector_Name (Node));
2087             Write_Str (" => ");
2088             Sprint_Node (Explicit_Actual_Parameter (Node));
2089
2090          when N_Parameter_Specification =>
2091             Set_Debug_Sloc;
2092
2093             if Write_Identifiers (Node) then
2094                Write_Str (" : ");
2095
2096                if In_Present (Node) then
2097                   Write_Str_With_Col_Check ("in ");
2098                end if;
2099
2100                if Out_Present (Node) then
2101                   Write_Str_With_Col_Check ("out ");
2102                end if;
2103
2104                --  Ada 2005 (AI-231)
2105
2106                if Null_Exclusion_Present (Node) then
2107                   Write_Str ("not null ");
2108                end if;
2109
2110                Sprint_Node (Parameter_Type (Node));
2111
2112                if Present (Expression (Node)) then
2113                   Write_Str (" := ");
2114                   Sprint_Node (Expression (Node));
2115                end if;
2116             else
2117                Write_Str (", ");
2118             end if;
2119
2120          when N_Pragma =>
2121             Write_Indent_Str_Sloc ("pragma ");
2122             Write_Name_With_Col_Check (Chars (Node));
2123
2124             if Present (Pragma_Argument_Associations (Node)) then
2125                Sprint_Opt_Paren_Comma_List
2126                  (Pragma_Argument_Associations (Node));
2127             end if;
2128
2129             Write_Char (';');
2130
2131          when N_Pragma_Argument_Association =>
2132             Set_Debug_Sloc;
2133
2134             if Chars (Node) /= No_Name then
2135                Write_Name_With_Col_Check (Chars (Node));
2136                Write_Str (" => ");
2137             end if;
2138
2139             Sprint_Node (Expression (Node));
2140
2141          when N_Private_Type_Declaration =>
2142             Write_Indent_Str_Sloc ("type ");
2143             Write_Id (Defining_Identifier (Node));
2144
2145             if Present (Discriminant_Specifications (Node)) then
2146                Write_Discr_Specs (Node);
2147             elsif Unknown_Discriminants_Present (Node) then
2148                Write_Str_With_Col_Check ("(<>)");
2149             end if;
2150
2151             Write_Str (" is ");
2152
2153             if Tagged_Present (Node) then
2154                Write_Str_With_Col_Check ("tagged ");
2155             end if;
2156
2157             if Limited_Present (Node) then
2158                Write_Str_With_Col_Check ("limited ");
2159             end if;
2160
2161             Write_Str_With_Col_Check ("private;");
2162
2163          when N_Private_Extension_Declaration =>
2164             Write_Indent_Str_Sloc ("type ");
2165             Write_Id (Defining_Identifier (Node));
2166
2167             if Present (Discriminant_Specifications (Node)) then
2168                Write_Discr_Specs (Node);
2169             elsif Unknown_Discriminants_Present (Node) then
2170                Write_Str_With_Col_Check ("(<>)");
2171             end if;
2172
2173             Write_Str_With_Col_Check (" is new ");
2174             Sprint_Node (Subtype_Indication (Node));
2175             Write_Str_With_Col_Check (" with private;");
2176
2177          when N_Procedure_Call_Statement =>
2178             Write_Indent;
2179             Set_Debug_Sloc;
2180             Note_Implicit_Run_Time_Call (Name (Node));
2181             Sprint_Node (Name (Node));
2182             Sprint_Opt_Paren_Comma_List (Parameter_Associations (Node));
2183             Write_Char (';');
2184
2185          when N_Procedure_Instantiation =>
2186             Write_Indent_Str_Sloc ("procedure ");
2187             Sprint_Node (Defining_Unit_Name (Node));
2188             Write_Str_With_Col_Check (" is new ");
2189             Sprint_Node (Name (Node));
2190             Sprint_Opt_Paren_Comma_List (Generic_Associations (Node));
2191             Write_Char (';');
2192
2193          when N_Procedure_Specification =>
2194             Write_Str_With_Col_Check_Sloc ("procedure ");
2195             Sprint_Node (Defining_Unit_Name (Node));
2196             Write_Param_Specs (Node);
2197
2198          when N_Protected_Body =>
2199             Write_Indent_Str_Sloc ("protected body ");
2200             Write_Id (Defining_Identifier (Node));
2201             Write_Str (" is");
2202             Sprint_Indented_List (Declarations (Node));
2203             Write_Indent_Str ("end ");
2204             Write_Id (Defining_Identifier (Node));
2205             Write_Char (';');
2206
2207          when N_Protected_Body_Stub =>
2208             Write_Indent_Str_Sloc ("protected body ");
2209             Write_Id (Defining_Identifier (Node));
2210             Write_Str_With_Col_Check (" is separate;");
2211
2212          when N_Protected_Definition =>
2213             Set_Debug_Sloc;
2214             Sprint_Indented_List (Visible_Declarations (Node));
2215
2216             if Present (Private_Declarations (Node)) then
2217                Write_Indent_Str ("private");
2218                Sprint_Indented_List (Private_Declarations (Node));
2219             end if;
2220
2221             Write_Indent_Str ("end ");
2222
2223          when N_Protected_Type_Declaration =>
2224             Write_Indent_Str_Sloc ("protected type ");
2225             Write_Id (Defining_Identifier (Node));
2226             Write_Discr_Specs (Node);
2227
2228             if Present (Interface_List (Node)) then
2229                Write_Str (" is new ");
2230                Sprint_And_List (Interface_List (Node));
2231                Write_Str (" with ");
2232             else
2233                Write_Str (" is");
2234             end if;
2235
2236             Sprint_Node (Protected_Definition (Node));
2237             Write_Id (Defining_Identifier (Node));
2238             Write_Char (';');
2239
2240          when N_Qualified_Expression =>
2241             Sprint_Node (Subtype_Mark (Node));
2242             Write_Char_Sloc (''');
2243
2244             --  Print expression, make sure we have at least one level of
2245             --  parentheses around the expression. For cases of qualified
2246             --  expressions in the source, this is always the case, but
2247             --  for generated qualifications, there may be no explicit
2248             --  parentheses present.
2249
2250             if Paren_Count (Expression (Node)) /= 0 then
2251                Sprint_Node (Expression (Node));
2252             else
2253                Write_Char ('(');
2254                Sprint_Node (Expression (Node));
2255                Write_Char (')');
2256             end if;
2257
2258          when N_Raise_Constraint_Error =>
2259
2260             --  This node can be used either as a subexpression or as a
2261             --  statement form. The following test is a reasonably reliable
2262             --  way to distinguish the two cases.
2263
2264             if Is_List_Member (Node)
2265               and then Nkind (Parent (Node)) not in N_Subexpr
2266             then
2267                Write_Indent;
2268             end if;
2269
2270             Write_Str_With_Col_Check_Sloc ("[constraint_error");
2271             Write_Condition_And_Reason (Node);
2272
2273          when N_Raise_Program_Error =>
2274
2275             --  This node can be used either as a subexpression or as a
2276             --  statement form. The following test is a reasonably reliable
2277             --  way to distinguish the two cases.
2278
2279             if Is_List_Member (Node)
2280               and then Nkind (Parent (Node)) not in N_Subexpr
2281             then
2282                Write_Indent;
2283             end if;
2284
2285             Write_Str_With_Col_Check_Sloc ("[program_error");
2286             Write_Condition_And_Reason (Node);
2287
2288          when N_Raise_Storage_Error =>
2289
2290             --  This node can be used either as a subexpression or as a
2291             --  statement form. The following test is a reasonably reliable
2292             --  way to distinguish the two cases.
2293
2294             if Is_List_Member (Node)
2295               and then Nkind (Parent (Node)) not in N_Subexpr
2296             then
2297                Write_Indent;
2298             end if;
2299
2300             Write_Str_With_Col_Check_Sloc ("[storage_error");
2301             Write_Condition_And_Reason (Node);
2302
2303          when N_Raise_Statement =>
2304             Write_Indent_Str_Sloc ("raise ");
2305             Sprint_Node (Name (Node));
2306             Write_Char (';');
2307
2308          when N_Range =>
2309             Sprint_Node (Low_Bound (Node));
2310             Write_Str_Sloc (" .. ");
2311             Sprint_Node (High_Bound (Node));
2312
2313          when N_Range_Constraint =>
2314             Write_Str_With_Col_Check_Sloc ("range ");
2315             Sprint_Node (Range_Expression (Node));
2316
2317          when N_Real_Literal =>
2318             Write_Ureal_With_Col_Check_Sloc (Realval (Node));
2319
2320          when N_Real_Range_Specification =>
2321             Write_Str_With_Col_Check_Sloc ("range ");
2322             Sprint_Node (Low_Bound (Node));
2323             Write_Str (" .. ");
2324             Sprint_Node (High_Bound (Node));
2325
2326          when N_Record_Definition =>
2327             if Abstract_Present (Node) then
2328                Write_Str_With_Col_Check ("abstract ");
2329             end if;
2330
2331             if Tagged_Present (Node) then
2332                Write_Str_With_Col_Check ("tagged ");
2333             end if;
2334
2335             if Limited_Present (Node) then
2336                Write_Str_With_Col_Check ("limited ");
2337             end if;
2338
2339             if Null_Present (Node) then
2340                Write_Str_With_Col_Check_Sloc ("null record");
2341
2342             else
2343                Write_Str_With_Col_Check_Sloc ("record");
2344                Sprint_Node (Component_List (Node));
2345                Write_Indent_Str ("end record");
2346             end if;
2347
2348          when N_Record_Representation_Clause =>
2349             Write_Indent_Str_Sloc ("for ");
2350             Sprint_Node (Identifier (Node));
2351             Write_Str_With_Col_Check (" use record ");
2352
2353             if Present (Mod_Clause (Node)) then
2354                Sprint_Node (Mod_Clause (Node));
2355             end if;
2356
2357             Sprint_Indented_List (Component_Clauses (Node));
2358             Write_Indent_Str ("end record;");
2359
2360          when N_Reference =>
2361             Sprint_Node (Prefix (Node));
2362             Write_Str_With_Col_Check_Sloc ("'reference");
2363
2364          when N_Requeue_Statement =>
2365             Write_Indent_Str_Sloc ("requeue ");
2366             Sprint_Node (Name (Node));
2367
2368             if Abort_Present (Node) then
2369                Write_Str_With_Col_Check (" with abort");
2370             end if;
2371
2372             Write_Char (';');
2373
2374          when N_Return_Statement =>
2375             if Present (Expression (Node)) then
2376                Write_Indent_Str_Sloc ("return ");
2377                Sprint_Node (Expression (Node));
2378                Write_Char (';');
2379             else
2380                Write_Indent_Str_Sloc ("return;");
2381             end if;
2382
2383          when N_Selective_Accept =>
2384             Write_Indent_Str_Sloc ("select");
2385
2386             declare
2387                Alt_Node : Node_Id;
2388             begin
2389                Alt_Node := First (Select_Alternatives (Node));
2390                loop
2391                   Indent_Begin;
2392                   Sprint_Node (Alt_Node);
2393                   Indent_End;
2394                   Next (Alt_Node);
2395                   exit when No (Alt_Node);
2396                   Write_Indent_Str ("or");
2397                end loop;
2398             end;
2399
2400             if Present (Else_Statements (Node)) then
2401                Write_Indent_Str ("else");
2402                Sprint_Indented_List (Else_Statements (Node));
2403             end if;
2404
2405             Write_Indent_Str ("end select;");
2406
2407          when N_Signed_Integer_Type_Definition =>
2408             Write_Str_With_Col_Check_Sloc ("range ");
2409             Sprint_Node (Low_Bound (Node));
2410             Write_Str (" .. ");
2411             Sprint_Node (High_Bound (Node));
2412
2413          when N_Single_Protected_Declaration =>
2414             Write_Indent_Str_Sloc ("protected ");
2415             Write_Id (Defining_Identifier (Node));
2416             Write_Str (" is");
2417             Sprint_Node (Protected_Definition (Node));
2418             Write_Id (Defining_Identifier (Node));
2419             Write_Char (';');
2420
2421          when N_Single_Task_Declaration =>
2422             Write_Indent_Str_Sloc ("task ");
2423             Write_Id (Defining_Identifier (Node));
2424
2425             if Present (Task_Definition (Node)) then
2426                Write_Str (" is");
2427                Sprint_Node (Task_Definition (Node));
2428                Write_Id (Defining_Identifier (Node));
2429             end if;
2430
2431             Write_Char (';');
2432
2433          when N_Selected_Component =>
2434             Sprint_Node (Prefix (Node));
2435             Write_Char_Sloc ('.');
2436             Sprint_Node (Selector_Name (Node));
2437
2438          when N_Slice =>
2439             Set_Debug_Sloc;
2440             Sprint_Node (Prefix (Node));
2441             Write_Str_With_Col_Check (" (");
2442             Sprint_Node (Discrete_Range (Node));
2443             Write_Char (')');
2444
2445          when N_String_Literal =>
2446             if String_Length (Strval (Node)) + Column > 75 then
2447                Write_Indent_Str ("  ");
2448             end if;
2449
2450             Set_Debug_Sloc;
2451             Write_String_Table_Entry (Strval (Node));
2452
2453          when N_Subprogram_Body =>
2454             if Freeze_Indent = 0 then
2455                Write_Indent;
2456             end if;
2457
2458             Write_Indent;
2459             Sprint_Node_Sloc (Specification (Node));
2460             Write_Str (" is");
2461
2462             Sprint_Indented_List (Declarations (Node));
2463             Write_Indent_Str ("begin");
2464             Sprint_Node (Handled_Statement_Sequence (Node));
2465
2466             Write_Indent_Str ("end ");
2467             Sprint_Node (Defining_Unit_Name (Specification (Node)));
2468             Write_Char (';');
2469
2470             if Is_List_Member (Node)
2471               and then Present (Next (Node))
2472               and then Nkind (Next (Node)) /= N_Subprogram_Body
2473             then
2474                Write_Indent;
2475             end if;
2476
2477          when N_Subprogram_Body_Stub =>
2478             Write_Indent;
2479             Sprint_Node_Sloc (Specification (Node));
2480             Write_Str_With_Col_Check (" is separate;");
2481
2482          when N_Subprogram_Declaration =>
2483             Write_Indent;
2484             Sprint_Node_Sloc (Specification (Node));
2485
2486             if Nkind (Specification (Node)) = N_Procedure_Specification
2487               and then Null_Present (Specification (Node))
2488             then
2489                Write_Str_With_Col_Check (" is null");
2490             end if;
2491
2492             Write_Char (';');
2493
2494          when N_Subprogram_Info =>
2495             Sprint_Node (Identifier (Node));
2496             Write_Str_With_Col_Check_Sloc ("'subprogram_info");
2497
2498          when N_Subprogram_Renaming_Declaration =>
2499             Write_Indent;
2500             Sprint_Node (Specification (Node));
2501             Write_Str_With_Col_Check_Sloc (" renames ");
2502             Sprint_Node (Name (Node));
2503             Write_Char (';');
2504
2505          when N_Subtype_Declaration =>
2506             Write_Indent_Str_Sloc ("subtype ");
2507             Write_Id (Defining_Identifier (Node));
2508             Write_Str (" is ");
2509
2510             --  Ada 2005 (AI-231)
2511
2512             if Null_Exclusion_Present (Node) then
2513                Write_Str ("not null ");
2514             end if;
2515
2516             Sprint_Node (Subtype_Indication (Node));
2517             Write_Char (';');
2518
2519          when N_Subtype_Indication =>
2520             Sprint_Node_Sloc (Subtype_Mark (Node));
2521             Write_Char (' ');
2522             Sprint_Node (Constraint (Node));
2523
2524          when N_Subunit =>
2525             Write_Indent_Str_Sloc ("separate (");
2526             Sprint_Node (Name (Node));
2527             Write_Char (')');
2528             Write_Eol;
2529             Sprint_Node (Proper_Body (Node));
2530
2531          when N_Task_Body =>
2532             Write_Indent_Str_Sloc ("task body ");
2533             Write_Id (Defining_Identifier (Node));
2534             Write_Str (" is");
2535             Sprint_Indented_List (Declarations (Node));
2536             Write_Indent_Str ("begin");
2537             Sprint_Node (Handled_Statement_Sequence (Node));
2538             Write_Indent_Str ("end ");
2539             Write_Id (Defining_Identifier (Node));
2540             Write_Char (';');
2541
2542          when N_Task_Body_Stub =>
2543             Write_Indent_Str_Sloc ("task body ");
2544             Write_Id (Defining_Identifier (Node));
2545             Write_Str_With_Col_Check (" is separate;");
2546
2547          when N_Task_Definition =>
2548             Set_Debug_Sloc;
2549             Sprint_Indented_List (Visible_Declarations (Node));
2550
2551             if Present (Private_Declarations (Node)) then
2552                Write_Indent_Str ("private");
2553                Sprint_Indented_List (Private_Declarations (Node));
2554             end if;
2555
2556             Write_Indent_Str ("end ");
2557
2558          when N_Task_Type_Declaration =>
2559             Write_Indent_Str_Sloc ("task type ");
2560             Write_Id (Defining_Identifier (Node));
2561             Write_Discr_Specs (Node);
2562
2563             if Present (Interface_List (Node)) then
2564                Write_Str (" is new ");
2565                Sprint_And_List (Interface_List (Node));
2566             end if;
2567
2568             if Present (Task_Definition (Node)) then
2569                if No (Interface_List (Node)) then
2570                   Write_Str (" is");
2571                else
2572                   Write_Str (" with ");
2573                end if;
2574
2575                Sprint_Node (Task_Definition (Node));
2576                Write_Id (Defining_Identifier (Node));
2577             end if;
2578
2579             Write_Char (';');
2580
2581          when N_Terminate_Alternative =>
2582             Sprint_Node_List (Pragmas_Before (Node));
2583
2584             Write_Indent;
2585
2586             if Present (Condition (Node)) then
2587                Write_Str_With_Col_Check ("when ");
2588                Sprint_Node (Condition (Node));
2589                Write_Str (" => ");
2590             end if;
2591
2592             Write_Str_With_Col_Check_Sloc ("terminate;");
2593             Sprint_Node_List (Pragmas_After (Node));
2594
2595          when N_Timed_Entry_Call =>
2596             Write_Indent_Str_Sloc ("select");
2597             Indent_Begin;
2598             Sprint_Node (Entry_Call_Alternative (Node));
2599             Indent_End;
2600             Write_Indent_Str ("or");
2601             Indent_Begin;
2602             Sprint_Node (Delay_Alternative (Node));
2603             Indent_End;
2604             Write_Indent_Str ("end select;");
2605
2606          when N_Triggering_Alternative =>
2607             Sprint_Node_List (Pragmas_Before (Node));
2608             Sprint_Node_Sloc (Triggering_Statement (Node));
2609             Sprint_Node_List (Statements (Node));
2610
2611          when N_Type_Conversion =>
2612             Set_Debug_Sloc;
2613             Sprint_Node (Subtype_Mark (Node));
2614             Col_Check (4);
2615
2616             if Conversion_OK (Node) then
2617                Write_Char ('?');
2618             end if;
2619
2620             if Float_Truncate (Node) then
2621                Write_Char ('^');
2622             end if;
2623
2624             if Rounded_Result (Node) then
2625                Write_Char ('@');
2626             end if;
2627
2628             Write_Char ('(');
2629             Sprint_Node (Expression (Node));
2630             Write_Char (')');
2631
2632          when N_Unchecked_Expression =>
2633             Col_Check (10);
2634             Write_Str ("`(");
2635             Sprint_Node_Sloc (Expression (Node));
2636             Write_Char (')');
2637
2638          when N_Unchecked_Type_Conversion =>
2639             Sprint_Node (Subtype_Mark (Node));
2640             Write_Char ('!');
2641             Write_Str_With_Col_Check ("(");
2642             Sprint_Node_Sloc (Expression (Node));
2643             Write_Char (')');
2644
2645          when N_Unconstrained_Array_Definition =>
2646             Write_Str_With_Col_Check_Sloc ("array (");
2647
2648             declare
2649                Node1 : Node_Id;
2650             begin
2651                Node1 := First (Subtype_Marks (Node));
2652                loop
2653                   Sprint_Node (Node1);
2654                   Write_Str_With_Col_Check (" range <>");
2655                   Next (Node1);
2656                   exit when Node1 = Empty;
2657                   Write_Str (", ");
2658                end loop;
2659             end;
2660
2661             Write_Str (") of ");
2662             Sprint_Node (Component_Definition (Node));
2663
2664          when N_Unused_At_Start | N_Unused_At_End =>
2665             Write_Indent_Str ("***** Error, unused node encountered *****");
2666             Write_Eol;
2667
2668          when N_Use_Package_Clause =>
2669             Write_Indent_Str_Sloc ("use ");
2670             Sprint_Comma_List (Names (Node));
2671             Write_Char (';');
2672
2673          when N_Use_Type_Clause =>
2674             Write_Indent_Str_Sloc ("use type ");
2675             Sprint_Comma_List (Subtype_Marks (Node));
2676             Write_Char (';');
2677
2678          when N_Validate_Unchecked_Conversion =>
2679             Write_Indent_Str_Sloc ("validate unchecked_conversion (");
2680             Sprint_Node (Source_Type (Node));
2681             Write_Str (", ");
2682             Sprint_Node (Target_Type (Node));
2683             Write_Str (");");
2684
2685          when N_Variant =>
2686             Write_Indent_Str_Sloc ("when ");
2687             Sprint_Bar_List (Discrete_Choices (Node));
2688             Write_Str (" => ");
2689             Sprint_Node (Component_List (Node));
2690
2691          when N_Variant_Part =>
2692             Indent_Begin;
2693             Write_Indent_Str_Sloc ("case ");
2694             Sprint_Node (Name (Node));
2695             Write_Str (" is ");
2696             Sprint_Indented_List (Variants (Node));
2697             Write_Indent_Str ("end case");
2698             Indent_End;
2699
2700          when N_With_Clause =>
2701
2702             --  Special test, if we are dumping the original tree only,
2703             --  then we want to eliminate the bogus with clauses that
2704             --  correspond to the non-existent children of Text_IO.
2705
2706             if Dump_Original_Only
2707               and then Is_Text_IO_Kludge_Unit (Name (Node))
2708             then
2709                null;
2710
2711             --  Normal case, output the with clause
2712
2713             else
2714                if First_Name (Node) or else not Dump_Original_Only then
2715
2716                   --  Ada 2005 (AI-50217): Print limited with_clauses
2717
2718                   if Private_Present (Node) and Limited_Present (Node) then
2719                      Write_Indent_Str ("limited private with ");
2720
2721                   elsif Private_Present (Node) then
2722                      Write_Indent_Str ("private with ");
2723
2724                   elsif Limited_Present (Node) then
2725                      Write_Indent_Str ("limited with ");
2726
2727                   else
2728                      Write_Indent_Str ("with ");
2729                   end if;
2730
2731                else
2732                   Write_Str (", ");
2733                end if;
2734
2735                Sprint_Node_Sloc (Name (Node));
2736
2737                if Last_Name (Node) or else not Dump_Original_Only then
2738                   Write_Char (';');
2739                end if;
2740             end if;
2741
2742          when N_With_Type_Clause =>
2743             Write_Indent_Str ("with type ");
2744             Sprint_Node_Sloc (Name (Node));
2745
2746             if Tagged_Present (Node) then
2747                Write_Str (" is tagged;");
2748             else
2749                Write_Str (" is access;");
2750             end if;
2751
2752       end case;
2753
2754       if Nkind (Node) in N_Subexpr
2755         and then Do_Range_Check (Node)
2756       then
2757          Write_Str ("}");
2758       end if;
2759
2760       for J in 1 .. Paren_Count (Node) loop
2761          Write_Char (')');
2762       end loop;
2763
2764       pragma Assert (No (Debug_Node));
2765       Debug_Node := Save_Debug_Node;
2766    end Sprint_Node_Actual;
2767
2768    ----------------------
2769    -- Sprint_Node_List --
2770    ----------------------
2771
2772    procedure Sprint_Node_List (List : List_Id) is
2773       Node : Node_Id;
2774
2775    begin
2776       if Is_Non_Empty_List (List) then
2777          Node := First (List);
2778
2779          loop
2780             Sprint_Node (Node);
2781             Next (Node);
2782             exit when Node = Empty;
2783          end loop;
2784       end if;
2785    end Sprint_Node_List;
2786
2787    ----------------------
2788    -- Sprint_Node_Sloc --
2789    ----------------------
2790
2791    procedure Sprint_Node_Sloc (Node : Node_Id) is
2792    begin
2793       Sprint_Node (Node);
2794
2795       if Present (Debug_Node) then
2796          Set_Sloc (Debug_Node, Sloc (Node));
2797          Debug_Node := Empty;
2798       end if;
2799    end Sprint_Node_Sloc;
2800
2801    ---------------------
2802    -- Sprint_Opt_Node --
2803    ---------------------
2804
2805    procedure Sprint_Opt_Node (Node : Node_Id) is
2806    begin
2807       if Present (Node) then
2808          Write_Char (' ');
2809          Sprint_Node (Node);
2810       end if;
2811    end Sprint_Opt_Node;
2812
2813    --------------------------
2814    -- Sprint_Opt_Node_List --
2815    --------------------------
2816
2817    procedure Sprint_Opt_Node_List (List : List_Id) is
2818    begin
2819       if Present (List) then
2820          Sprint_Node_List (List);
2821       end if;
2822    end Sprint_Opt_Node_List;
2823
2824    ---------------------------------
2825    -- Sprint_Opt_Paren_Comma_List --
2826    ---------------------------------
2827
2828    procedure Sprint_Opt_Paren_Comma_List (List : List_Id) is
2829    begin
2830       if Is_Non_Empty_List (List) then
2831          Write_Char (' ');
2832          Sprint_Paren_Comma_List (List);
2833       end if;
2834    end Sprint_Opt_Paren_Comma_List;
2835
2836    -----------------------------
2837    -- Sprint_Paren_Comma_List --
2838    -----------------------------
2839
2840    procedure Sprint_Paren_Comma_List (List : List_Id) is
2841       N           : Node_Id;
2842       Node_Exists : Boolean := False;
2843
2844    begin
2845
2846       if Is_Non_Empty_List (List) then
2847
2848          if Dump_Original_Only then
2849             N := First (List);
2850             while Present (N) loop
2851                if not Is_Rewrite_Insertion (N) then
2852                   Node_Exists := True;
2853                   exit;
2854                end if;
2855
2856                Next (N);
2857             end loop;
2858
2859             if not Node_Exists then
2860                return;
2861             end if;
2862          end if;
2863
2864          Write_Str_With_Col_Check ("(");
2865          Sprint_Comma_List (List);
2866          Write_Char (')');
2867       end if;
2868    end Sprint_Paren_Comma_List;
2869
2870    ----------------------
2871    -- Sprint_Right_Opnd --
2872    ----------------------
2873
2874    procedure Sprint_Right_Opnd (N : Node_Id) is
2875       Opnd : constant Node_Id := Right_Opnd (N);
2876
2877    begin
2878       if Paren_Count (Opnd) /= 0
2879         or else Op_Prec (Nkind (Opnd)) > Op_Prec (Nkind (N))
2880       then
2881          Sprint_Node (Opnd);
2882
2883       else
2884          Write_Char ('(');
2885          Sprint_Node (Opnd);
2886          Write_Char (')');
2887       end if;
2888    end Sprint_Right_Opnd;
2889
2890    ---------------------
2891    -- Write_Char_Sloc --
2892    ---------------------
2893
2894    procedure Write_Char_Sloc (C : Character) is
2895    begin
2896       if Debug_Generated_Code and then C /= ' ' then
2897          Set_Debug_Sloc;
2898       end if;
2899
2900       Write_Char (C);
2901    end Write_Char_Sloc;
2902
2903    --------------------------------
2904    -- Write_Condition_And_Reason --
2905    --------------------------------
2906
2907    procedure Write_Condition_And_Reason (Node : Node_Id) is
2908       Image : constant String := RT_Exception_Code'Image
2909                                    (RT_Exception_Code'Val
2910                                      (UI_To_Int (Reason (Node))));
2911
2912    begin
2913       if Present (Condition (Node)) then
2914          Write_Str_With_Col_Check (" when ");
2915          Sprint_Node (Condition (Node));
2916       end if;
2917
2918       Write_Str (" """);
2919
2920       for J in 4 .. Image'Last loop
2921          if Image (J) = '_' then
2922             Write_Char (' ');
2923          else
2924             Write_Char (Fold_Lower (Image (J)));
2925          end if;
2926       end loop;
2927
2928       Write_Str ("""]");
2929    end Write_Condition_And_Reason;
2930
2931    -----------------------
2932    -- Write_Discr_Specs --
2933    -----------------------
2934
2935    procedure Write_Discr_Specs (N : Node_Id) is
2936       Specs : List_Id;
2937       Spec  : Node_Id;
2938
2939    begin
2940       Specs := Discriminant_Specifications (N);
2941
2942       if Present (Specs) then
2943          Write_Str_With_Col_Check (" (");
2944          Spec := First (Specs);
2945
2946          loop
2947             Sprint_Node (Spec);
2948             Next (Spec);
2949             exit when Spec = Empty;
2950
2951             --  Add semicolon, unless we are printing original tree and the
2952             --  next specification is part of a list (but not the first
2953             --  element of that list)
2954
2955             if not Dump_Original_Only or else not Prev_Ids (Spec) then
2956                Write_Str ("; ");
2957             end if;
2958          end loop;
2959
2960          Write_Char (')');
2961       end if;
2962    end Write_Discr_Specs;
2963
2964    -----------------
2965    -- Write_Ekind --
2966    -----------------
2967
2968    procedure Write_Ekind (E : Entity_Id) is
2969       S : constant String := Entity_Kind'Image (Ekind (E));
2970
2971    begin
2972       Name_Len := S'Length;
2973       Name_Buffer (1 .. Name_Len) := S;
2974       Set_Casing (Mixed_Case);
2975       Write_Str_With_Col_Check (Name_Buffer (1 .. Name_Len));
2976    end Write_Ekind;
2977
2978    --------------
2979    -- Write_Id --
2980    --------------
2981
2982    procedure Write_Id (N : Node_Id) is
2983    begin
2984       --  Deal with outputting Itype
2985
2986       --  Note: if we are printing the full tree with -gnatds, then we may
2987       --  end up picking up the Associated_Node link from a generic template
2988       --  here which overlaps the Entity field, but as documented, Write_Itype
2989       --  is defended against junk calls.
2990
2991       if Nkind (N) in N_Entity then
2992          Write_Itype (N);
2993       elsif Nkind (N) in N_Has_Entity then
2994          Write_Itype (Entity (N));
2995       end if;
2996
2997       --  Case of a defining identifier
2998
2999       if Nkind (N) = N_Defining_Identifier then
3000
3001          --  If defining identifier has an interface name (and no
3002          --  address clause), then we output the interface name.
3003
3004          if (Is_Imported (N) or else Is_Exported (N))
3005            and then Present (Interface_Name (N))
3006            and then No (Address_Clause (N))
3007          then
3008             String_To_Name_Buffer (Strval (Interface_Name (N)));
3009             Write_Str_With_Col_Check (Name_Buffer (1 .. Name_Len));
3010
3011          --  If no interface name (or inactive because there was
3012          --  an address clause), then just output the Chars name.
3013
3014          else
3015             Write_Name_With_Col_Check (Chars (N));
3016          end if;
3017
3018       --  Case of selector of an expanded name where the expanded name
3019       --  has an associated entity, output this entity.
3020
3021       elsif Nkind (Parent (N)) = N_Expanded_Name
3022         and then Selector_Name (Parent (N)) = N
3023         and then Present (Entity (Parent (N)))
3024       then
3025          Write_Id (Entity (Parent (N)));
3026
3027       --  For any other node with an associated entity, output it
3028
3029       elsif Nkind (N) in N_Has_Entity
3030         and then Present (Entity_Or_Associated_Node (N))
3031         and then Nkind (Entity_Or_Associated_Node (N)) in N_Entity
3032       then
3033          Write_Id (Entity (N));
3034
3035       --  All other cases, we just print the Chars field
3036
3037       else
3038          Write_Name_With_Col_Check (Chars (N));
3039       end if;
3040    end Write_Id;
3041
3042    -----------------------
3043    -- Write_Identifiers --
3044    -----------------------
3045
3046    function Write_Identifiers (Node : Node_Id) return Boolean is
3047    begin
3048       Sprint_Node (Defining_Identifier (Node));
3049
3050       --  The remainder of the declaration must be printed unless we are
3051       --  printing the original tree and this is not the last identifier
3052
3053       return
3054          not Dump_Original_Only or else not More_Ids (Node);
3055
3056    end Write_Identifiers;
3057
3058    ------------------------
3059    -- Write_Implicit_Def --
3060    ------------------------
3061
3062    procedure Write_Implicit_Def (E : Entity_Id) is
3063       Ind : Node_Id;
3064
3065    begin
3066       case Ekind (E) is
3067          when E_Array_Subtype =>
3068             Write_Str_With_Col_Check ("subtype ");
3069             Write_Id (E);
3070             Write_Str_With_Col_Check (" is ");
3071             Write_Id (Base_Type (E));
3072             Write_Str_With_Col_Check (" (");
3073
3074             Ind := First_Index (E);
3075             while Present (Ind) loop
3076                Sprint_Node (Ind);
3077                Next_Index (Ind);
3078
3079                if Present (Ind) then
3080                   Write_Str (", ");
3081                end if;
3082             end loop;
3083
3084             Write_Str (");");
3085
3086          when E_Signed_Integer_Subtype | E_Enumeration_Subtype =>
3087             Write_Str_With_Col_Check ("subtype ");
3088             Write_Id (E);
3089             Write_Str (" is ");
3090             Write_Id (Etype (E));
3091             Write_Str_With_Col_Check (" range ");
3092             Sprint_Node (Scalar_Range (E));
3093             Write_Str (";");
3094
3095          when others =>
3096             Write_Str_With_Col_Check ("type ");
3097             Write_Id (E);
3098             Write_Str_With_Col_Check (" is <");
3099             Write_Ekind (E);
3100             Write_Str (">;");
3101       end case;
3102
3103    end Write_Implicit_Def;
3104
3105    ------------------
3106    -- Write_Indent --
3107    ------------------
3108
3109    procedure Write_Indent is
3110    begin
3111       if Indent_Annull_Flag then
3112          Indent_Annull_Flag := False;
3113       else
3114          Write_Eol;
3115
3116          for J in 1 .. Indent loop
3117             Write_Char (' ');
3118          end loop;
3119       end if;
3120    end Write_Indent;
3121
3122    ------------------------------
3123    -- Write_Indent_Identifiers --
3124    ------------------------------
3125
3126    function Write_Indent_Identifiers (Node : Node_Id) return Boolean is
3127    begin
3128       --  We need to start a new line for every node, except in the case
3129       --  where we are printing the original tree and this is not the first
3130       --  defining identifier in the list.
3131
3132       if not Dump_Original_Only or else not Prev_Ids (Node) then
3133          Write_Indent;
3134
3135       --  If printing original tree and this is not the first defining
3136       --  identifier in the list, then the previous call to this procedure
3137       --  printed only the name, and we add a comma to separate the names.
3138
3139       else
3140          Write_Str (", ");
3141       end if;
3142
3143       Sprint_Node (Defining_Identifier (Node));
3144
3145       --  The remainder of the declaration must be printed unless we are
3146       --  printing the original tree and this is not the last identifier
3147
3148       return
3149          not Dump_Original_Only or else not More_Ids (Node);
3150
3151    end Write_Indent_Identifiers;
3152
3153    -----------------------------------
3154    -- Write_Indent_Identifiers_Sloc --
3155    -----------------------------------
3156
3157    function Write_Indent_Identifiers_Sloc (Node : Node_Id) return Boolean is
3158    begin
3159       --  We need to start a new line for every node, except in the case
3160       --  where we are printing the original tree and this is not the first
3161       --  defining identifier in the list.
3162
3163       if not Dump_Original_Only or else not Prev_Ids (Node) then
3164          Write_Indent;
3165
3166       --  If printing original tree and this is not the first defining
3167       --  identifier in the list, then the previous call to this procedure
3168       --  printed only the name, and we add a comma to separate the names.
3169
3170       else
3171          Write_Str (", ");
3172       end if;
3173
3174       Set_Debug_Sloc;
3175       Sprint_Node (Defining_Identifier (Node));
3176
3177       --  The remainder of the declaration must be printed unless we are
3178       --  printing the original tree and this is not the last identifier
3179
3180       return
3181          not Dump_Original_Only or else not More_Ids (Node);
3182
3183    end Write_Indent_Identifiers_Sloc;
3184
3185    ----------------------
3186    -- Write_Indent_Str --
3187    ----------------------
3188
3189    procedure Write_Indent_Str (S : String) is
3190    begin
3191       Write_Indent;
3192       Write_Str (S);
3193    end Write_Indent_Str;
3194
3195    ---------------------------
3196    -- Write_Indent_Str_Sloc --
3197    ---------------------------
3198
3199    procedure Write_Indent_Str_Sloc (S : String) is
3200    begin
3201       Write_Indent;
3202       Write_Str_Sloc (S);
3203    end Write_Indent_Str_Sloc;
3204
3205    -----------------
3206    -- Write_Itype --
3207    -----------------
3208
3209    procedure Write_Itype (Typ : Entity_Id) is
3210
3211       procedure Write_Header (T : Boolean := True);
3212       --  Write type if T is True, subtype if T is false
3213
3214       ------------------
3215       -- Write_Header --
3216       ------------------
3217
3218       procedure Write_Header (T : Boolean := True) is
3219       begin
3220          if T then
3221             Write_Str ("[type ");
3222          else
3223             Write_Str ("[subtype ");
3224          end if;
3225
3226          Write_Name_With_Col_Check (Chars (Typ));
3227          Write_Str (" is ");
3228       end Write_Header;
3229
3230    --  Start of processing for Write_Itype
3231
3232    begin
3233       if Nkind (Typ) in N_Entity
3234         and then Is_Itype (Typ)
3235         and then not Itype_Printed (Typ)
3236       then
3237          --  Itype to be printed
3238
3239          declare
3240             B : constant Node_Id := Etype (Typ);
3241             X : Node_Id;
3242             P : constant Node_Id := Parent (Typ);
3243
3244             S : constant Saved_Output_Buffer := Save_Output_Buffer;
3245             --  Save current output buffer
3246
3247             Old_Sloc : Source_Ptr;
3248             --  Save sloc of related node, so it is not modified when
3249             --  printing with -gnatD.
3250
3251          begin
3252             --  Write indentation at start of line
3253
3254             for J in 1 .. Indent loop
3255                Write_Char (' ');
3256             end loop;
3257
3258             --  If we have a constructed declaration, print it
3259
3260             if Present (P) and then Nkind (P) in N_Declaration then
3261
3262                --  We must set Itype_Printed true before the recursive call to
3263                --  print the node, otherwise we get an infinite recursion!
3264
3265                Set_Itype_Printed (Typ, True);
3266
3267                --  Write the declaration enclosed in [], avoiding new line
3268                --  at start of declaration, and semicolon at end.
3269
3270                --  Note: The itype may be imported from another unit, in which
3271                --  case we do not want to modify the Sloc of the declaration.
3272                --  Otherwise the itype may appear to be in the current unit,
3273                --  and the back-end will reject a reference out of scope.
3274
3275                Write_Char ('[');
3276                Indent_Annull_Flag := True;
3277                Old_Sloc := Sloc (P);
3278                Sprint_Node (P);
3279                Set_Sloc (P, Old_Sloc);
3280                Write_Erase_Char (';');
3281
3282             --  If no constructed declaration, then we have to concoct the
3283             --  source corresponding to the type entity that we have at hand.
3284
3285             else
3286                case Ekind (Typ) is
3287
3288                   --  Access types and subtypes
3289
3290                   when Access_Kind =>
3291                      Write_Header (Ekind (Typ) = E_Access_Type);
3292                      Write_Str ("access ");
3293
3294                      if Is_Access_Constant (Typ) then
3295                         Write_Str ("constant ");
3296                      elsif Can_Never_Be_Null (Typ) then
3297                         Write_Str ("not null ");
3298                      end if;
3299
3300                      Write_Id (Directly_Designated_Type (Typ));
3301
3302                      --  Array types and string types
3303
3304                   when E_Array_Type | E_String_Type =>
3305                      Write_Header;
3306                      Write_Str ("array (");
3307
3308                      X := First_Index (Typ);
3309                      loop
3310                         Sprint_Node (X);
3311
3312                         if not Is_Constrained (Typ) then
3313                            Write_Str (" range <>");
3314                         end if;
3315
3316                         Next_Index (X);
3317                         exit when No (X);
3318                         Write_Str (", ");
3319                      end loop;
3320
3321                      Write_Str (") of ");
3322                      Sprint_Node (Component_Type (Typ));
3323
3324                      --  Array subtypes and string subtypes
3325
3326                   when E_Array_Subtype | E_String_Subtype =>
3327                      Write_Header (False);
3328                      Write_Id (Etype (Typ));
3329                      Write_Str (" (");
3330
3331                      X := First_Index (Typ);
3332                      loop
3333                         Sprint_Node (X);
3334                         Next_Index (X);
3335                         exit when No (X);
3336                         Write_Str (", ");
3337                      end loop;
3338
3339                      Write_Char (')');
3340
3341                      --  Signed integer types, and modular integer subtypes
3342
3343                   when E_Signed_Integer_Type     |
3344                        E_Signed_Integer_Subtype  |
3345                        E_Modular_Integer_Subtype =>
3346
3347                      Write_Header (Ekind (Typ) = E_Signed_Integer_Type);
3348
3349                      if Ekind (Typ) = E_Signed_Integer_Type then
3350                         Write_Str ("new ");
3351                      end if;
3352
3353                      Write_Id (B);
3354
3355                      --  Print bounds if not different from base type
3356
3357                      declare
3358                         L  : constant Node_Id := Type_Low_Bound (Typ);
3359                         H  : constant Node_Id := Type_High_Bound (Typ);
3360                         LE : constant Node_Id := Type_Low_Bound (B);
3361                         HE : constant Node_Id := Type_High_Bound (B);
3362
3363                      begin
3364                         if Nkind (L) = N_Integer_Literal
3365                           and then Nkind (H) = N_Integer_Literal
3366                           and then Nkind (LE) = N_Integer_Literal
3367                           and then Nkind (HE) = N_Integer_Literal
3368                           and then UI_Eq (Intval (L), Intval (LE))
3369                           and then UI_Eq (Intval (H), Intval (HE))
3370                         then
3371                            null;
3372
3373                         else
3374                            Write_Str (" range ");
3375                            Sprint_Node (Type_Low_Bound (Typ));
3376                            Write_Str (" .. ");
3377                            Sprint_Node (Type_High_Bound (Typ));
3378                         end if;
3379                      end;
3380
3381                      --  Modular integer types
3382
3383                   when E_Modular_Integer_Type =>
3384                      Write_Header;
3385                      Write_Str (" mod ");
3386                      Write_Uint_With_Col_Check (Modulus (Typ), Auto);
3387
3388                      --  Floating point types and subtypes
3389
3390                   when E_Floating_Point_Type    |
3391                        E_Floating_Point_Subtype =>
3392
3393                      Write_Header (Ekind (Typ) = E_Floating_Point_Type);
3394
3395                      if Ekind (Typ) = E_Floating_Point_Type then
3396                         Write_Str ("new ");
3397                      end if;
3398
3399                      Write_Id (Etype (Typ));
3400
3401                      if Digits_Value (Typ) /= Digits_Value (Etype (Typ)) then
3402                         Write_Str (" digits ");
3403                         Write_Uint_With_Col_Check
3404                           (Digits_Value (Typ), Decimal);
3405                      end if;
3406
3407                      --  Print bounds if not different from base type
3408
3409                      declare
3410                         L  : constant Node_Id := Type_Low_Bound (Typ);
3411                         H  : constant Node_Id := Type_High_Bound (Typ);
3412                         LE : constant Node_Id := Type_Low_Bound (B);
3413                         HE : constant Node_Id := Type_High_Bound (B);
3414
3415                      begin
3416                         if Nkind (L) = N_Real_Literal
3417                           and then Nkind (H) = N_Real_Literal
3418                           and then Nkind (LE) = N_Real_Literal
3419                           and then Nkind (HE) = N_Real_Literal
3420                           and then UR_Eq (Realval (L), Realval (LE))
3421                           and then UR_Eq (Realval (H), Realval (HE))
3422                         then
3423                            null;
3424
3425                         else
3426                            Write_Str (" range ");
3427                            Sprint_Node (Type_Low_Bound (Typ));
3428                            Write_Str (" .. ");
3429                            Sprint_Node (Type_High_Bound (Typ));
3430                         end if;
3431                      end;
3432
3433                   --  Record subtypes
3434
3435                   when E_Record_Subtype =>
3436                      Write_Header (False);
3437                      Write_Str ("record");
3438                      Indent_Begin;
3439
3440                      declare
3441                         C : Entity_Id;
3442                      begin
3443                         C := First_Entity (Typ);
3444                         while Present (C) loop
3445                            Write_Indent;
3446                            Write_Id (C);
3447                            Write_Str (" : ");
3448                            Write_Id (Etype (C));
3449                            Next_Entity (C);
3450                         end loop;
3451                      end;
3452
3453                      Indent_End;
3454                      Write_Indent_Str (" end record");
3455
3456                   --  Class-Wide types
3457
3458                   when E_Class_Wide_Type =>
3459                      Write_Header;
3460                      Write_Name_With_Col_Check (Chars (Etype (Typ)));
3461                      Write_Str ("'Class");
3462
3463                   --  Subprogram types
3464
3465                   when E_Subprogram_Type =>
3466                      Write_Header;
3467
3468                      if Etype (Typ) = Standard_Void_Type then
3469                         Write_Str ("procedure");
3470                      else
3471                         Write_Str ("function");
3472                      end if;
3473
3474                      if Present (First_Entity (Typ)) then
3475                         Write_Str (" (");
3476
3477                         declare
3478                            Param : Entity_Id;
3479
3480                         begin
3481                            Param := First_Entity (Typ);
3482                            loop
3483                               Write_Id (Param);
3484                               Write_Str (" : ");
3485
3486                               if Ekind (Param) = E_In_Out_Parameter then
3487                                  Write_Str ("in out ");
3488                               elsif Ekind (Param) = E_Out_Parameter then
3489                                  Write_Str ("out ");
3490                               end if;
3491
3492                               Write_Id (Etype (Param));
3493                               Next_Entity (Param);
3494                               exit when No (Param);
3495                               Write_Str (", ");
3496                            end loop;
3497
3498                            Write_Char (')');
3499                         end;
3500                      end if;
3501
3502                      if Etype (Typ) /= Standard_Void_Type then
3503                         Write_Str (" return ");
3504                         Write_Id (Etype (Typ));
3505                      end if;
3506
3507                   --  For all other Itypes, print ??? (fill in later)
3508
3509                   when others =>
3510                      Write_Header (True);
3511                      Write_Str ("???");
3512
3513                end case;
3514             end if;
3515
3516             --  Add terminating bracket and restore output buffer
3517
3518             Write_Char (']');
3519             Write_Eol;
3520             Restore_Output_Buffer (S);
3521          end;
3522
3523          Set_Itype_Printed (Typ);
3524       end if;
3525    end Write_Itype;
3526
3527    -------------------------------
3528    -- Write_Name_With_Col_Check --
3529    -------------------------------
3530
3531    procedure Write_Name_With_Col_Check (N : Name_Id) is
3532       J : Natural;
3533
3534    begin
3535       Get_Name_String (N);
3536
3537       --  Deal with -gnatI which replaces digits in an internal
3538       --  name by three dots (e.g. R7b becomes R...b).
3539
3540       if Debug_Flag_II and then Name_Buffer (1) in 'A' .. 'Z' then
3541          J := 2;
3542          while J < Name_Len loop
3543             exit when Name_Buffer (J) not in 'A' .. 'Z';
3544             J := J + 1;
3545          end loop;
3546
3547          if Name_Buffer (J) in '0' .. '9' then
3548             Write_Str_With_Col_Check (Name_Buffer (1 .. J - 1));
3549             Write_Str ("...");
3550
3551             while J <= Name_Len loop
3552                if Name_Buffer (J) not in '0' .. '9' then
3553                   Write_Str (Name_Buffer (J .. Name_Len));
3554                   exit;
3555
3556                else
3557                   J := J + 1;
3558                end if;
3559             end loop;
3560
3561             return;
3562          end if;
3563       end if;
3564
3565       --  Fall through for normal case
3566
3567       Write_Str_With_Col_Check (Name_Buffer (1 .. Name_Len));
3568    end Write_Name_With_Col_Check;
3569
3570    ------------------------------------
3571    -- Write_Name_With_Col_Check_Sloc --
3572    ------------------------------------
3573
3574    procedure Write_Name_With_Col_Check_Sloc (N : Name_Id) is
3575    begin
3576       Get_Name_String (N);
3577       Write_Str_With_Col_Check_Sloc (Name_Buffer (1 .. Name_Len));
3578    end Write_Name_With_Col_Check_Sloc;
3579
3580    --------------------
3581    -- Write_Operator --
3582    --------------------
3583
3584    procedure Write_Operator (N : Node_Id; S : String) is
3585       F : Natural := S'First;
3586       T : Natural := S'Last;
3587
3588    begin
3589       --  If no overflow check, just write string out, and we are done
3590
3591       if not Do_Overflow_Check (N) then
3592          Write_Str_Sloc (S);
3593
3594       --  If overflow check, we want to surround the operator with curly
3595       --  brackets, but not include spaces within the brackets.
3596
3597       else
3598          if S (F) = ' ' then
3599             Write_Char (' ');
3600             F := F + 1;
3601          end if;
3602
3603          if S (T) = ' ' then
3604             T := T - 1;
3605          end if;
3606
3607          Write_Char ('{');
3608          Write_Str_Sloc (S (F .. T));
3609          Write_Char ('}');
3610
3611          if S (S'Last) = ' ' then
3612             Write_Char (' ');
3613          end if;
3614       end if;
3615    end Write_Operator;
3616
3617    -----------------------
3618    -- Write_Param_Specs --
3619    -----------------------
3620
3621    procedure Write_Param_Specs (N : Node_Id) is
3622       Specs  : List_Id;
3623       Spec   : Node_Id;
3624       Formal : Node_Id;
3625
3626    begin
3627       Specs := Parameter_Specifications (N);
3628
3629       if Is_Non_Empty_List (Specs) then
3630          Write_Str_With_Col_Check (" (");
3631          Spec := First (Specs);
3632
3633          loop
3634             Sprint_Node (Spec);
3635             Formal := Defining_Identifier (Spec);
3636             Next (Spec);
3637             exit when Spec = Empty;
3638
3639             --  Add semicolon, unless we are printing original tree and the
3640             --  next specification is part of a list (but not the first
3641             --  element of that list)
3642
3643             if not Dump_Original_Only or else not Prev_Ids (Spec) then
3644                Write_Str ("; ");
3645             end if;
3646          end loop;
3647
3648          --  Write out any extra formals
3649
3650          while Present (Extra_Formal (Formal)) loop
3651             Formal := Extra_Formal (Formal);
3652             Write_Str ("; ");
3653             Write_Name_With_Col_Check (Chars (Formal));
3654             Write_Str (" : ");
3655             Write_Name_With_Col_Check (Chars (Etype (Formal)));
3656          end loop;
3657
3658          Write_Char (')');
3659       end if;
3660    end Write_Param_Specs;
3661
3662    --------------------------
3663    -- Write_Rewrite_Str --
3664    --------------------------
3665
3666    procedure Write_Rewrite_Str (S : String) is
3667    begin
3668       if not Dump_Generated_Only then
3669          if S'Length = 3 and then S = ">>>" then
3670             Write_Str (">>>");
3671          else
3672             Write_Str_With_Col_Check (S);
3673          end if;
3674       end if;
3675    end Write_Rewrite_Str;
3676
3677    --------------------
3678    -- Write_Str_Sloc --
3679    --------------------
3680
3681    procedure Write_Str_Sloc (S : String) is
3682    begin
3683       for J in S'Range loop
3684          Write_Char_Sloc (S (J));
3685       end loop;
3686    end Write_Str_Sloc;
3687
3688    ------------------------------
3689    -- Write_Str_With_Col_Check --
3690    ------------------------------
3691
3692    procedure Write_Str_With_Col_Check (S : String) is
3693    begin
3694       if Int (S'Last) + Column > Line_Limit then
3695          Write_Indent_Str ("  ");
3696
3697          if S (1) = ' ' then
3698             Write_Str (S (2 .. S'Length));
3699          else
3700             Write_Str (S);
3701          end if;
3702
3703       else
3704          Write_Str (S);
3705       end if;
3706    end Write_Str_With_Col_Check;
3707
3708    -----------------------------------
3709    -- Write_Str_With_Col_Check_Sloc --
3710    -----------------------------------
3711
3712    procedure Write_Str_With_Col_Check_Sloc (S : String) is
3713    begin
3714       if Int (S'Last) + Column > Line_Limit then
3715          Write_Indent_Str ("  ");
3716
3717          if S (1) = ' ' then
3718             Write_Str_Sloc (S (2 .. S'Length));
3719          else
3720             Write_Str_Sloc (S);
3721          end if;
3722
3723       else
3724          Write_Str_Sloc (S);
3725       end if;
3726    end Write_Str_With_Col_Check_Sloc;
3727
3728    -------------------------------
3729    -- Write_Uint_With_Col_Check --
3730    -------------------------------
3731
3732    procedure Write_Uint_With_Col_Check (U : Uint; Format : UI_Format) is
3733    begin
3734       Col_Check (UI_Decimal_Digits_Hi (U));
3735       UI_Write (U, Format);
3736    end Write_Uint_With_Col_Check;
3737
3738    ------------------------------------
3739    -- Write_Uint_With_Col_Check_Sloc --
3740    ------------------------------------
3741
3742    procedure Write_Uint_With_Col_Check_Sloc (U : Uint; Format : UI_Format) is
3743    begin
3744       Col_Check (UI_Decimal_Digits_Hi (U));
3745       Set_Debug_Sloc;
3746       UI_Write (U, Format);
3747    end Write_Uint_With_Col_Check_Sloc;
3748
3749    -------------------------------------
3750    -- Write_Ureal_With_Col_Check_Sloc --
3751    -------------------------------------
3752
3753    procedure Write_Ureal_With_Col_Check_Sloc (U : Ureal) is
3754       D : constant Uint := Denominator (U);
3755       N : constant Uint := Numerator (U);
3756
3757    begin
3758       Col_Check
3759         (UI_Decimal_Digits_Hi (D) + UI_Decimal_Digits_Hi (N) + 4);
3760       Set_Debug_Sloc;
3761       UR_Write (U);
3762    end Write_Ureal_With_Col_Check_Sloc;
3763
3764 end Sprint;