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