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