File : gnat1drv.adb


   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             G N A T 1 D R V                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25 
  26 with Atree;    use Atree;
  27 with Back_End; use Back_End;
  28 with Checks;
  29 with Comperr;
  30 with Cprint;
  31 with Csets;    use Csets;
  32 with Debug;    use Debug;
  33 with Elists;
  34 with Errout;   use Errout;
  35 with Exp_CG;
  36 with Fmap;
  37 with Fname;    use Fname;
  38 with Fname.UF; use Fname.UF;
  39 with Frontend;
  40 with Ghost;
  41 with Gnatvsn;  use Gnatvsn;
  42 with Inline;
  43 with Lib;      use Lib;
  44 with Lib.Writ; use Lib.Writ;
  45 with Lib.Xref;
  46 with Namet;    use Namet;
  47 with Nlists;
  48 with Opt;      use Opt;
  49 with Osint;    use Osint;
  50 with Osint.C;  use Osint.C;
  51 with Output;   use Output;
  52 with Par_SCO;
  53 with Prepcomp;
  54 with Repinfo;  use Repinfo;
  55 with Restrict;
  56 with Rident;   use Rident;
  57 with Rtsfind;
  58 with SCOs;
  59 with Sem;
  60 with Sem_Ch8;
  61 with Sem_Ch12;
  62 with Sem_Ch13;
  63 with Sem_Elim;
  64 with Sem_Eval;
  65 with Sem_Type;
  66 with Set_Targ;
  67 with Sinfo;    use Sinfo;
  68 with Sinput.L; use Sinput.L;
  69 with Snames;
  70 with Sprint;   use Sprint;
  71 with Stringt;
  72 with Stylesw;  use Stylesw;
  73 with Targparm; use Targparm;
  74 with Tbuild;
  75 with Tree_Gen;
  76 with Treepr;   use Treepr;
  77 with Ttypes;
  78 with Types;    use Types;
  79 with Uintp;    use Uintp;
  80 with Uname;    use Uname;
  81 with Urealp;
  82 with Usage;
  83 with Validsw;  use Validsw;
  84 
  85 with System.Assertions;
  86 with System.OS_Lib;
  87 
  88 --------------
  89 -- Gnat1drv --
  90 --------------
  91 
  92 procedure Gnat1drv is
  93    Main_Unit_Node : Node_Id;
  94    --  Compilation unit node for main unit
  95 
  96    Main_Kind : Node_Kind;
  97    --  Kind of main compilation unit node
  98 
  99    Back_End_Mode : Back_End.Back_End_Mode_Type;
 100    --  Record back-end mode
 101 
 102    procedure Adjust_Global_Switches;
 103    --  There are various interactions between front-end switch settings,
 104    --  including debug switch settings and target dependent parameters.
 105    --  This procedure takes care of properly handling these interactions.
 106    --  We do it after scanning out all the switches, so that we are not
 107    --  depending on the order in which switches appear.
 108 
 109    procedure Check_Bad_Body;
 110    --  Called to check if the unit we are compiling has a bad body
 111 
 112    procedure Check_Rep_Info;
 113    --  Called when we are not generating code, to check if -gnatR was requested
 114    --  and if so, explain that we will not be honoring the request.
 115 
 116    procedure Post_Compilation_Validation_Checks;
 117    --  This procedure performs various validation checks that have to be left
 118    --  to the end of the compilation process, after generating code but before
 119    --  issuing error messages. In particular, these checks generally require
 120    --  the information provided by the back end in back annotation of declared
 121    --  entities (e.g. actual size and alignment values chosen by the back end).
 122 
 123    ----------------------------
 124    -- Adjust_Global_Switches --
 125    ----------------------------
 126 
 127    procedure Adjust_Global_Switches is
 128    begin
 129       --  -gnatd.M enables Relaxed_RM_Semantics
 130 
 131       if Debug_Flag_Dot_MM then
 132          Relaxed_RM_Semantics := True;
 133       end if;
 134 
 135       --  -gnatd.1 enables unnesting of subprograms
 136 
 137       if Debug_Flag_Dot_1 then
 138          Unnest_Subprogram_Mode := True;
 139       end if;
 140 
 141       --  -gnatd.u enables special C expansion mode
 142 
 143       if Debug_Flag_Dot_U then
 144          Modify_Tree_For_C := True;
 145       end if;
 146 
 147       --  Set all flags required when generating C code
 148 
 149       if Generate_C_Code then
 150          Modify_Tree_For_C := True;
 151          Unnest_Subprogram_Mode := True;
 152          Minimize_Expression_With_Actions := True;
 153 
 154          --  Set operating mode to Generate_Code to benefit from full front-end
 155          --  expansion (e.g. generics).
 156 
 157          Operating_Mode := Generate_Code;
 158 
 159          --  Suppress alignment checks since we do not have access to alignment
 160          --  info on the target.
 161 
 162          Suppress_Options.Suppress (Alignment_Check) := False;
 163       end if;
 164 
 165       --  -gnatd.E sets Error_To_Warning mode, causing selected error messages
 166       --  to be treated as warnings instead of errors.
 167 
 168       if Debug_Flag_Dot_EE then
 169          Error_To_Warning := True;
 170       end if;
 171 
 172       --  Disable CodePeer_Mode in Check_Syntax, since we need front-end
 173       --  expansion.
 174 
 175       if Operating_Mode = Check_Syntax then
 176          CodePeer_Mode := False;
 177       end if;
 178 
 179       --  Set ASIS mode if -gnatt and -gnatc are set
 180 
 181       if Operating_Mode = Check_Semantics and then Tree_Output then
 182          ASIS_Mode := True;
 183 
 184          --  Set ASIS GNSA mode if -gnatd.H is set
 185 
 186          if Debug_Flag_Dot_HH then
 187             ASIS_GNSA_Mode := True;
 188          end if;
 189 
 190          --  Turn off inlining in ASIS mode, since ASIS cannot handle the extra
 191          --  information in the trees caused by inlining being active.
 192 
 193          --  More specifically, the tree seems to be malformed from the ASIS
 194          --  point of view if -gnatc and -gnatn appear together???
 195 
 196          Inline_Active := False;
 197 
 198          --  Turn off SCIL generation and CodePeer mode in semantics mode,
 199          --  since SCIL requires front-end expansion.
 200 
 201          Generate_SCIL := False;
 202          CodePeer_Mode := False;
 203       end if;
 204 
 205       --  SCIL mode needs to disable front-end inlining since the generated
 206       --  trees (in particular order and consistency between specs compiled
 207       --  as part of a main unit or as part of a with-clause) are causing
 208       --  troubles.
 209 
 210       if Generate_SCIL then
 211          Front_End_Inlining := False;
 212       end if;
 213 
 214       --  Tune settings for optimal SCIL generation in CodePeer mode
 215 
 216       if CodePeer_Mode then
 217 
 218          --  Turn off gnatprove mode (which can be set via e.g. -gnatd.F), not
 219          --  compatible with CodePeer mode.
 220 
 221          GNATprove_Mode := False;
 222          Debug_Flag_Dot_FF := False;
 223 
 224          --  Turn off C tree generation, not compatible with CodePeer mode. We
 225          --  do not expect this to happen in normal use, since both modes are
 226          --  enabled by special tools, but it is useful to turn off these flags
 227          --  this way when we are doing CodePeer tests on existing test suites
 228          --  that may have -gnateg set, to avoid the need for special casing.
 229 
 230          Modify_Tree_For_C := False;
 231          Generate_C_Code := False;
 232          Unnest_Subprogram_Mode := False;
 233 
 234          --  Turn off inlining, confuses CodePeer output and gains nothing
 235 
 236          Front_End_Inlining := False;
 237          Inline_Active      := False;
 238 
 239          --  Disable front-end optimizations, to keep the tree as close to the
 240          --  source code as possible, and also to avoid inconsistencies between
 241          --  trees when using different optimization switches.
 242 
 243          Optimization_Level := 0;
 244 
 245          --  Enable some restrictions systematically to simplify the generated
 246          --  code (and ease analysis). Note that restriction checks are also
 247          --  disabled in CodePeer mode, see Restrict.Check_Restriction, and
 248          --  user specified Restrictions pragmas are ignored, see
 249          --  Sem_Prag.Process_Restrictions_Or_Restriction_Warnings.
 250 
 251          Restrict.Restrictions.Set   (No_Exception_Registration)       := True;
 252          Restrict.Restrictions.Set   (No_Initialize_Scalars)           := True;
 253          Restrict.Restrictions.Set   (No_Task_Hierarchy)               := True;
 254          Restrict.Restrictions.Set   (No_Abort_Statements)             := True;
 255          Restrict.Restrictions.Set   (Max_Asynchronous_Select_Nesting) := True;
 256          Restrict.Restrictions.Value (Max_Asynchronous_Select_Nesting) := 0;
 257 
 258          --  Suppress division by zero and access checks since they are handled
 259          --  implicitly by CodePeer.
 260 
 261          --  Turn off dynamic elaboration checks: generates inconsistencies in
 262          --  trees between specs compiled as part of a main unit or as part of
 263          --  a with-clause.
 264 
 265          --  Turn off alignment checks: these cannot be proved statically by
 266          --  CodePeer and generate false positives.
 267 
 268          --  Enable all other language checks
 269 
 270          Suppress_Options.Suppress :=
 271            (Alignment_Check   => True,
 272             Division_Check    => True,
 273             Elaboration_Check => True,
 274             others            => False);
 275 
 276          Dynamic_Elaboration_Checks := False;
 277 
 278          --  Set STRICT mode for overflow checks if not set explicitly. This
 279          --  prevents suppressing of overflow checks by default, in code down
 280          --  below.
 281 
 282          if Suppress_Options.Overflow_Mode_General = Not_Set then
 283             Suppress_Options.Overflow_Mode_General    := Strict;
 284             Suppress_Options.Overflow_Mode_Assertions := Strict;
 285          end if;
 286 
 287          --  CodePeer handles division and overflow checks directly, based on
 288          --  the marks set by the frontend, hence no special expansion should
 289          --  be performed in the frontend for division and overflow checks.
 290 
 291          Backend_Divide_Checks_On_Target   := True;
 292          Backend_Overflow_Checks_On_Target := True;
 293 
 294          --  Kill debug of generated code, since it messes up sloc values
 295 
 296          Debug_Generated_Code := False;
 297 
 298          --  Turn cross-referencing on in case it was disabled (e.g. by -gnatD)
 299          --  to support source navigation.
 300 
 301          Xref_Active := True;
 302 
 303          --  Polling mode forced off, since it generates confusing junk
 304 
 305          Polling_Required := False;
 306 
 307          --  Set operating mode to Generate_Code to benefit from full front-end
 308          --  expansion (e.g. generics).
 309 
 310          Operating_Mode := Generate_Code;
 311 
 312          --  We need SCIL generation of course
 313 
 314          Generate_SCIL := True;
 315 
 316          --  Enable assertions, since they give CodePeer valuable extra info
 317 
 318          Assertions_Enabled := True;
 319 
 320          --  Set normal RM validity checking and checking of copies (to catch
 321          --  e.g. wrong values used in unchecked conversions).
 322          --  All other validity checking is turned off, since this can generate
 323          --  very complex trees that only confuse CodePeer and do not bring
 324          --  enough useful info.
 325 
 326          Reset_Validity_Check_Options;
 327          Validity_Check_Default       := True;
 328          Validity_Check_Copies        := True;
 329 
 330          --  Turn off style check options and ignore any style check pragmas
 331          --  since we are not interested in any front-end warnings when we are
 332          --  getting CodePeer output.
 333 
 334          Reset_Style_Check_Options;
 335          Ignore_Style_Checks_Pragmas := True;
 336 
 337          --  Always perform semantics and generate ali files in CodePeer mode,
 338          --  so that a gnatmake -c -k will proceed further when possible.
 339 
 340          Force_ALI_Tree_File := True;
 341          Try_Semantics := True;
 342 
 343          --  Make the Ada front end more liberal so that the compiler will
 344          --  allow illegal code that is allowed by other compilers. CodePeer
 345          --  is in the business of finding problems, not enforcing rules.
 346          --  This is useful when using CodePeer mode with other compilers.
 347 
 348          Relaxed_RM_Semantics := True;
 349 
 350          --  Disable all simple value propagation. This is an optimization
 351          --  which is valuable for code optimization, and also for generation
 352          --  of compiler warnings, but these are being turned off by default,
 353          --  and CodePeer generates better messages (referencing original
 354          --  variables) this way.
 355          --  Do this only is -gnatws is set (the default with -gnatcC), so that
 356          --  if warnings are enabled, we'll get better messages from GNAT.
 357 
 358          if Warning_Mode = Suppress then
 359             Debug_Flag_MM := True;
 360          end if;
 361       end if;
 362 
 363       --  Enable some individual switches that are implied by relaxed RM
 364       --  semantics mode.
 365 
 366       if Relaxed_RM_Semantics then
 367          Opt.Allow_Integer_Address := True;
 368          Overriding_Renamings := True;
 369          Treat_Categorization_Errors_As_Warnings := True;
 370       end if;
 371 
 372       --  Enable GNATprove_Mode when using -gnatd.F switch
 373 
 374       if Debug_Flag_Dot_FF then
 375          GNATprove_Mode := True;
 376       end if;
 377 
 378       --  GNATprove_Mode is also activated by default in the gnat2why
 379       --  executable.
 380 
 381       if GNATprove_Mode then
 382 
 383          --  Turn off inlining, which would confuse formal verification output
 384          --  and gain nothing.
 385 
 386          Front_End_Inlining := False;
 387          Inline_Active      := False;
 388 
 389          --  Issue warnings for failure to inline subprograms, as otherwise
 390          --  expected in GNATprove mode for the local subprograms without
 391          --  contracts.
 392 
 393          Ineffective_Inline_Warnings := True;
 394 
 395          --  Disable front-end optimizations, to keep the tree as close to the
 396          --  source code as possible, and also to avoid inconsistencies between
 397          --  trees when using different optimization switches.
 398 
 399          Optimization_Level := 0;
 400 
 401          --  Enable some restrictions systematically to simplify the generated
 402          --  code (and ease analysis).
 403 
 404          Restrict.Restrictions.Set (No_Initialize_Scalars) := True;
 405 
 406          --  Note: at this point we used to suppress various checks, but that
 407          --  is not what we want. We need the semantic processing for these
 408          --  checks (which will set flags like Do_Overflow_Check, showing the
 409          --  points at which potential checks are required semantically). We
 410          --  don't want the expansion associated with these checks, but that
 411          --  happens anyway because this expansion is simply not done in the
 412          --  SPARK version of the expander.
 413 
 414          --  On the contrary, we need to enable explicitly all language checks,
 415          --  as they may have been suppressed by the use of switch -gnatp.
 416 
 417          Suppress_Options.Suppress := (others => False);
 418 
 419          --  Detect overflow on unconstrained floating-point types, such as
 420          --  the predefined types Float, Long_Float and Long_Long_Float from
 421          --  package Standard. Not necessary if float overflows are checked
 422          --  (Machine_Overflow true), since appropriate Do_Overflow_Check flags
 423          --  will be set in any case.
 424 
 425          Check_Float_Overflow := not Machine_Overflows_On_Target;
 426 
 427          --  Set STRICT mode for overflow checks if not set explicitly. This
 428          --  prevents suppressing of overflow checks by default, in code down
 429          --  below.
 430 
 431          if Suppress_Options.Overflow_Mode_General = Not_Set then
 432             Suppress_Options.Overflow_Mode_General    := Strict;
 433             Suppress_Options.Overflow_Mode_Assertions := Strict;
 434          end if;
 435 
 436          --  Kill debug of generated code, since it messes up sloc values
 437 
 438          Debug_Generated_Code := False;
 439 
 440          --  Turn cross-referencing on in case it was disabled (e.g. by -gnatD)
 441          --  as it is needed for computing effects of subprograms in the formal
 442          --  verification backend.
 443 
 444          Xref_Active := True;
 445 
 446          --  Polling mode forced off, since it generates confusing junk
 447 
 448          Polling_Required := False;
 449 
 450          --  Set operating mode to Check_Semantics, but a light front-end
 451          --  expansion is still performed.
 452 
 453          Operating_Mode := Check_Semantics;
 454 
 455          --  Enable assertions, since they give valuable extra information for
 456          --  formal verification.
 457 
 458          Assertions_Enabled := True;
 459 
 460          --  Disable validity checks, since it generates code raising
 461          --  exceptions for invalid data, which confuses GNATprove. Invalid
 462          --  data is directly detected by GNATprove's flow analysis.
 463 
 464          Validity_Checks_On := False;
 465 
 466          --  Turn off style check options since we are not interested in any
 467          --  front-end warnings when we are getting SPARK output.
 468 
 469          Reset_Style_Check_Options;
 470 
 471          --  Suppress the generation of name tables for enumerations, which are
 472          --  not needed for formal verification, and fall outside the SPARK
 473          --  subset (use of pointers).
 474 
 475          Global_Discard_Names := True;
 476 
 477          --  Suppress the expansion of tagged types and dispatching calls,
 478          --  which lead to the generation of non-SPARK code (use of pointers),
 479          --  which is more complex to formally verify than the original source.
 480 
 481          Tagged_Type_Expansion := False;
 482       end if;
 483 
 484       --  Set Configurable_Run_Time mode if system.ads flag set or if the
 485       --  special debug flag -gnatdY is set.
 486 
 487       if Targparm.Configurable_Run_Time_On_Target or Debug_Flag_YY then
 488          Configurable_Run_Time_Mode := True;
 489       end if;
 490 
 491       --  Set -gnatR3m mode if debug flag A set
 492 
 493       if Debug_Flag_AA then
 494          Back_Annotate_Rep_Info := True;
 495          List_Representation_Info := 1;
 496          List_Representation_Info_Mechanisms := True;
 497       end if;
 498 
 499       --  Force Target_Strict_Alignment true if debug flag -gnatd.a is set
 500 
 501       if Debug_Flag_Dot_A then
 502          Ttypes.Target_Strict_Alignment := True;
 503       end if;
 504 
 505       --  Increase size of allocated entities if debug flag -gnatd.N is set
 506 
 507       if Debug_Flag_Dot_NN then
 508          Atree.Num_Extension_Nodes := Atree.Num_Extension_Nodes + 1;
 509       end if;
 510 
 511       --  Disable static allocation of dispatch tables if -gnatd.t or if layout
 512       --  is enabled. The front end's layout phase currently treats types that
 513       --  have discriminant-dependent arrays as not being static even when a
 514       --  discriminant constraint on the type is static, and this leads to
 515       --  problems with subtypes of type Ada.Tags.Dispatch_Table_Wrapper. ???
 516 
 517       if Debug_Flag_Dot_T or else Frontend_Layout_On_Target then
 518          Static_Dispatch_Tables := False;
 519       end if;
 520 
 521       --  Flip endian mode if -gnatd8 set
 522 
 523       if Debug_Flag_8 then
 524          Ttypes.Bytes_Big_Endian := not Ttypes.Bytes_Big_Endian;
 525       end if;
 526 
 527       --  Activate front-end layout if debug flag -gnatdF is set
 528 
 529       if Debug_Flag_FF then
 530          Targparm.Frontend_Layout_On_Target := True;
 531       end if;
 532 
 533       --  Set and check exception mechanism
 534 
 535       case Targparm.Frontend_Exceptions_On_Target is
 536          when True =>
 537             case Targparm.ZCX_By_Default_On_Target is
 538                when True =>
 539                   Write_Line
 540                     ("Run-time library configured incorrectly");
 541                   Write_Line
 542                     ("(requesting support for Frontend ZCX exceptions)");
 543                   raise Unrecoverable_Error;
 544                when False =>
 545                   Exception_Mechanism := Front_End_SJLJ;
 546             end case;
 547          when False =>
 548             case Targparm.ZCX_By_Default_On_Target is
 549                when True =>
 550                   Exception_Mechanism := Back_End_ZCX;
 551                when False =>
 552                   Exception_Mechanism := Back_End_SJLJ;
 553             end case;
 554       end case;
 555 
 556       --  Set proper status for overflow check mechanism
 557 
 558       --  If already set (by -gnato or above in SPARK or CodePeer mode) then we
 559       --  have nothing to do.
 560 
 561       if Opt.Suppress_Options.Overflow_Mode_General /= Not_Set then
 562          null;
 563 
 564       --  Otherwise set overflow mode defaults
 565 
 566       else
 567          --  Overflow checks are on by default (Suppress set False) except in
 568          --  GNAT_Mode, where we want them off by default (we are not ready to
 569          --  enable overflow checks in the compiler yet, for one thing the case
 570          --  of 64-bit checks needs System.Arith_64 which is not a compiler
 571          --  unit and it is a pain to try to include it in the compiler.
 572 
 573          Suppress_Options.Suppress (Overflow_Check) := GNAT_Mode;
 574 
 575          --  Set appropriate default overflow handling mode. Note: at present
 576          --  we set STRICT in all three of the following cases. They are
 577          --  separated because in the future we may make different choices.
 578 
 579          --  By default set STRICT mode if -gnatg in effect
 580 
 581          if GNAT_Mode then
 582             Suppress_Options.Overflow_Mode_General    := Strict;
 583             Suppress_Options.Overflow_Mode_Assertions := Strict;
 584 
 585          --  If we have backend divide and overflow checks, then by default
 586          --  overflow checks are STRICT. Historically this code used to also
 587          --  activate overflow checks, although no target currently has these
 588          --  flags set, so this was dead code anyway.
 589 
 590          elsif Targparm.Backend_Divide_Checks_On_Target
 591                  and
 592                Targparm.Backend_Overflow_Checks_On_Target
 593          then
 594             Suppress_Options.Overflow_Mode_General    := Strict;
 595             Suppress_Options.Overflow_Mode_Assertions := Strict;
 596 
 597          --  Otherwise for now, default is STRICT mode. This may change in the
 598          --  future, but for now this is the compatible behavior with previous
 599          --  versions of GNAT.
 600 
 601          else
 602             Suppress_Options.Overflow_Mode_General    := Strict;
 603             Suppress_Options.Overflow_Mode_Assertions := Strict;
 604          end if;
 605       end if;
 606 
 607       --  Set default for atomic synchronization. As this synchronization
 608       --  between atomic accesses can be expensive, and not typically needed
 609       --  on some targets, an optional target parameter can turn the option
 610       --  off. Note Atomic Synchronization is implemented as check.
 611 
 612       Suppress_Options.Suppress (Atomic_Synchronization) :=
 613         not Atomic_Sync_Default_On_Target;
 614 
 615       --  Set default for Alignment_Check, if we are on a machine with non-
 616       --  strict alignment, then we suppress this check, since it is over-
 617       --  zealous for such machines.
 618 
 619       if not Ttypes.Target_Strict_Alignment then
 620          Suppress_Options.Suppress (Alignment_Check) := True;
 621       end if;
 622 
 623       --  Set switch indicating if back end can handle limited types, and
 624       --  guarantee that no incorrect copies are made (e.g. in the context
 625       --  of an if or case expression).
 626 
 627       --  Debug flag -gnatd.L decisively sets usage on
 628 
 629       if Debug_Flag_Dot_LL then
 630          Back_End_Handles_Limited_Types := True;
 631 
 632       --  If no debug flag, usage off for SCIL cases
 633 
 634       elsif Generate_SCIL then
 635          Back_End_Handles_Limited_Types := False;
 636 
 637       --  Otherwise normal gcc back end, for now still turn flag off by
 638       --  default, since there are unresolved problems in the front end.
 639 
 640       else
 641          Back_End_Handles_Limited_Types := False;
 642       end if;
 643 
 644       --  If the inlining level has not been set by the user, compute it from
 645       --  the optimization level: 1 at -O1/-O2 (and -Os), 2 at -O3 and above.
 646 
 647       if Inline_Level = 0 then
 648          if Optimization_Level < 3 then
 649             Inline_Level := 1;
 650          else
 651             Inline_Level := 2;
 652          end if;
 653       end if;
 654 
 655       --  Treat -gnatn as equivalent to -gnatN for non-GCC targets
 656 
 657       if Inline_Active and not Front_End_Inlining then
 658 
 659          --  We really should have a tag for this, what if we added a new
 660          --  back end some day, it would not be true for this test, but it
 661          --  would be non-GCC, so this is a bit troublesome ???
 662 
 663          Front_End_Inlining := Generate_C_Code;
 664       end if;
 665 
 666       --  Set back-end inlining indication
 667 
 668       Back_End_Inlining :=
 669 
 670         --  No back-end inlining available on C generation
 671 
 672         not Generate_C_Code
 673 
 674         --  No back-end inlining in GNATprove mode, since it just confuses
 675         --  the formal verification process.
 676 
 677         and then not GNATprove_Mode
 678 
 679         --  No back-end inlining if front-end inlining explicitly enabled.
 680         --  Done to minimize the output differences to customers still using
 681         --  this deprecated switch; in addition, this behavior reduces the
 682         --  output differences in old tests.
 683 
 684         and then not Front_End_Inlining
 685 
 686         --  Back-end inlining is disabled if debug flag .z is set
 687 
 688         and then not Debug_Flag_Dot_Z;
 689 
 690       --  Output warning if -gnateE specified and cannot be supported
 691 
 692       if Exception_Extra_Info
 693         and then Restrict.No_Exception_Handlers_Set
 694       then
 695          Set_Standard_Error;
 696          Write_Str
 697            ("warning: extra exception information (-gnateE) was specified");
 698          Write_Eol;
 699          Write_Str
 700            ("warning: this capability is not available in this configuration");
 701          Write_Eol;
 702          Set_Standard_Output;
 703       end if;
 704 
 705       --  Finally capture adjusted value of Suppress_Options as the initial
 706       --  value for Scope_Suppress, which will be modified as we move from
 707       --  scope to scope (by Suppress/Unsuppress/Overflow_Checks pragmas).
 708 
 709       Sem.Scope_Suppress := Opt.Suppress_Options;
 710    end Adjust_Global_Switches;
 711 
 712    --------------------
 713    -- Check_Bad_Body --
 714    --------------------
 715 
 716    procedure Check_Bad_Body is
 717       Sname   : Unit_Name_Type;
 718       Src_Ind : Source_File_Index;
 719       Fname   : File_Name_Type;
 720 
 721       procedure Bad_Body_Error (Msg : String);
 722       --  Issue message for bad body found
 723 
 724       --------------------
 725       -- Bad_Body_Error --
 726       --------------------
 727 
 728       procedure Bad_Body_Error (Msg : String) is
 729       begin
 730          Error_Msg_N (Msg, Main_Unit_Node);
 731          Error_Msg_File_1 := Fname;
 732          Error_Msg_N ("remove incorrect body in file{!", Main_Unit_Node);
 733       end Bad_Body_Error;
 734 
 735    --  Start of processing for Check_Bad_Body
 736 
 737    begin
 738       --  Nothing to do if we are only checking syntax, because we don't know
 739       --  enough to know if we require or forbid a body in this case.
 740 
 741       if Operating_Mode = Check_Syntax then
 742          return;
 743       end if;
 744 
 745       --  Check for body not allowed
 746 
 747       if (Main_Kind = N_Package_Declaration
 748            and then not Body_Required (Main_Unit_Node))
 749         or else (Main_Kind = N_Generic_Package_Declaration
 750                   and then not Body_Required (Main_Unit_Node))
 751         or else Main_Kind = N_Package_Renaming_Declaration
 752         or else Main_Kind = N_Subprogram_Renaming_Declaration
 753         or else Nkind (Original_Node (Unit (Main_Unit_Node)))
 754                          in N_Generic_Instantiation
 755       then
 756          Sname := Unit_Name (Main_Unit);
 757 
 758          --  If we do not already have a body name, then get the body name
 759 
 760          if not Is_Body_Name (Sname) then
 761             Sname := Get_Body_Name (Sname);
 762          end if;
 763 
 764          Fname := Get_File_Name (Sname, Subunit => False);
 765          Src_Ind := Load_Source_File (Fname);
 766 
 767          --  Case where body is present and it is not a subunit. Exclude the
 768          --  subunit case, because it has nothing to do with the package we are
 769          --  compiling. It is illegal for a child unit and a subunit with the
 770          --  same expanded name (RM 10.2(9)) to appear together in a partition,
 771          --  but there is nothing to stop a compilation environment from having
 772          --  both, and the test here simply allows that. If there is an attempt
 773          --  to include both in a partition, this is diagnosed at bind time. In
 774          --  Ada 83 mode this is not a warning case.
 775 
 776          --  Note that in general we do not give the message if the file in
 777          --  question does not look like a body. This includes weird cases,
 778          --  but in particular means that if the file is just a No_Body pragma,
 779          --  then we won't give the message (that's the whole point of this
 780          --  pragma, to be used this way and to cause the body file to be
 781          --  ignored in this context).
 782 
 783          if Src_Ind /= No_Source_File
 784            and then Source_File_Is_Body (Src_Ind)
 785          then
 786             Errout.Finalize (Last_Call => False);
 787 
 788             Error_Msg_Unit_1 := Sname;
 789 
 790             --  Ada 83 case of a package body being ignored. This is not an
 791             --  error as far as the Ada 83 RM is concerned, but it is almost
 792             --  certainly not what is wanted so output a warning. Give this
 793             --  message only if there were no errors, since otherwise it may
 794             --  be incorrect (we may have misinterpreted a junk spec as not
 795             --  needing a body when it really does).
 796 
 797             if Main_Kind = N_Package_Declaration
 798               and then Ada_Version = Ada_83
 799               and then Operating_Mode = Generate_Code
 800               and then Distribution_Stub_Mode /= Generate_Caller_Stub_Body
 801               and then not Compilation_Errors
 802             then
 803                Error_Msg_N
 804                  ("package $$ does not require a body??", Main_Unit_Node);
 805                Error_Msg_File_1 := Fname;
 806                Error_Msg_N ("body in file{ will be ignored??", Main_Unit_Node);
 807 
 808                --  Ada 95 cases of a body file present when no body is
 809                --  permitted. This we consider to be an error.
 810 
 811             else
 812                --  For generic instantiations, we never allow a body
 813 
 814                if Nkind (Original_Node (Unit (Main_Unit_Node))) in
 815                                                     N_Generic_Instantiation
 816                then
 817                   Bad_Body_Error
 818                     ("generic instantiation for $$ does not allow a body");
 819 
 820                   --  A library unit that is a renaming never allows a body
 821 
 822                elsif Main_Kind in N_Renaming_Declaration then
 823                   Bad_Body_Error
 824                     ("renaming declaration for $$ does not allow a body!");
 825 
 826                   --  Remaining cases are packages and generic packages. Here
 827                   --  we only do the test if there are no previous errors,
 828                   --  because if there are errors, they may lead us to
 829                   --  incorrectly believe that a package does not allow a
 830                   --  body when in fact it does.
 831 
 832                elsif not Compilation_Errors then
 833                   if Main_Kind = N_Package_Declaration then
 834                      Bad_Body_Error
 835                        ("package $$ does not allow a body!");
 836 
 837                   elsif Main_Kind = N_Generic_Package_Declaration then
 838                      Bad_Body_Error
 839                        ("generic package $$ does not allow a body!");
 840                   end if;
 841                end if;
 842 
 843             end if;
 844          end if;
 845       end if;
 846    end Check_Bad_Body;
 847 
 848    --------------------
 849    -- Check_Rep_Info --
 850    --------------------
 851 
 852    procedure Check_Rep_Info is
 853    begin
 854       if List_Representation_Info /= 0
 855         or else List_Representation_Info_Mechanisms
 856       then
 857          Set_Standard_Error;
 858          Write_Eol;
 859          Write_Str
 860            ("cannot generate representation information, no code generated");
 861          Write_Eol;
 862          Write_Eol;
 863          Set_Standard_Output;
 864       end if;
 865    end Check_Rep_Info;
 866 
 867    ----------------------------------------
 868    -- Post_Compilation_Validation_Checks --
 869    ----------------------------------------
 870 
 871    procedure Post_Compilation_Validation_Checks is
 872    begin
 873       --  Validate alignment check warnings. In some cases we generate warnings
 874       --  about possible alignment errors because we don't know the alignment
 875       --  that will be chosen by the back end. This routine is in charge of
 876       --  getting rid of those warnings if we can tell they are not needed.
 877 
 878       Checks.Validate_Alignment_Check_Warnings;
 879 
 880       --  Validate unchecked conversions (using the values for size and
 881       --  alignment annotated by the backend where possible).
 882 
 883       Sem_Ch13.Validate_Unchecked_Conversions;
 884 
 885       --  Validate address clauses (again using alignment values annotated
 886       --  by the backend where possible).
 887 
 888       Sem_Ch13.Validate_Address_Clauses;
 889 
 890       --  Validate independence pragmas (again using values annotated by the
 891       --  back end for component layout where possible) but only for non-GCC
 892       --  back ends, as this is done a priori for GCC back ends.
 893 
 894       if AAMP_On_Target then
 895          Sem_Ch13.Validate_Independence;
 896       end if;
 897 
 898    end Post_Compilation_Validation_Checks;
 899 
 900 --  Start of processing for Gnat1drv
 901 
 902 begin
 903    --  This inner block is set up to catch assertion errors and constraint
 904    --  errors. Since the code for handling these errors can cause another
 905    --  exception to be raised (namely Unrecoverable_Error), we need two
 906    --  nested blocks, so that the outer one handles unrecoverable error.
 907 
 908    begin
 909       --  Initialize all packages. For the most part, these initialization
 910       --  calls can be made in any order. Exceptions are as follows:
 911 
 912       --  Lib.Initialize need to be called before Scan_Compiler_Arguments,
 913       --  because it initializes a table filled by Scan_Compiler_Arguments.
 914 
 915       Osint.Initialize;
 916       Fmap.Reset_Tables;
 917       Lib.Initialize;
 918       Lib.Xref.Initialize;
 919       Scan_Compiler_Arguments;
 920       Osint.Add_Default_Search_Dirs;
 921       Atree.Initialize;
 922       Nlists.Initialize;
 923       Sinput.Initialize;
 924       Sem.Initialize;
 925       Exp_CG.Initialize;
 926       Csets.Initialize;
 927       Uintp.Initialize;
 928       Urealp.Initialize;
 929       Errout.Initialize;
 930       SCOs.Initialize;
 931       Snames.Initialize;
 932       Stringt.Initialize;
 933       Ghost.Initialize;
 934       Inline.Initialize;
 935       Par_SCO.Initialize;
 936       Sem_Ch8.Initialize;
 937       Sem_Ch12.Initialize;
 938       Sem_Ch13.Initialize;
 939       Sem_Elim.Initialize;
 940       Sem_Eval.Initialize;
 941       Sem_Type.Init_Interp_Tables;
 942 
 943       --  Capture compilation date and time
 944 
 945       Opt.Compilation_Time := System.OS_Lib.Current_Time_String;
 946 
 947       --  Get the target parameters only when -gnats is not used, to avoid
 948       --  failing when there is no default runtime.
 949 
 950       if Operating_Mode /= Check_Syntax then
 951 
 952          --  Acquire target parameters from system.ads (package System source)
 953 
 954          Targparm_Acquire : declare
 955             use Sinput;
 956 
 957             S : Source_File_Index;
 958             N : File_Name_Type;
 959 
 960          begin
 961             Name_Buffer (1 .. 10) := "system.ads";
 962             Name_Len := 10;
 963             N := Name_Find;
 964             S := Load_Source_File (N);
 965 
 966             --  Failed to read system.ads, fatal error
 967 
 968             if S = No_Source_File then
 969                Write_Line
 970                  ("fatal error, run-time library not installed correctly");
 971                Write_Line ("cannot locate file system.ads");
 972                raise Unrecoverable_Error;
 973 
 974             --  Read system.ads successfully, remember its source index
 975 
 976             else
 977                System_Source_File_Index := S;
 978             end if;
 979 
 980             --  Call to get target parameters. Note that the actual interface
 981             --  routines are in Tbuild. They can't be in this procedure because
 982             --  of accessibility issues.
 983 
 984             Targparm.Get_Target_Parameters
 985               (System_Text  => Source_Text  (S),
 986                Source_First => Source_First (S),
 987                Source_Last  => Source_Last  (S),
 988                Make_Id      => Tbuild.Make_Id'Access,
 989                Make_SC      => Tbuild.Make_SC'Access,
 990                Set_NOD      => Tbuild.Set_NOD'Access,
 991                Set_NSA      => Tbuild.Set_NSA'Access,
 992                Set_NUA      => Tbuild.Set_NUA'Access,
 993                Set_NUP      => Tbuild.Set_NUP'Access);
 994 
 995             --  Acquire configuration pragma information from Targparm
 996 
 997             Restrict.Restrictions := Targparm.Restrictions_On_Target;
 998          end Targparm_Acquire;
 999       end if;
1000 
1001       --  Perform various adjustments and settings of global switches
1002 
1003       Adjust_Global_Switches;
1004 
1005       --  Output copyright notice if full list mode unless we have a list
1006       --  file, in which case we defer this so that it is output in the file.
1007 
1008       if (Verbose_Mode or else (Full_List and then Full_List_File_Name = null))
1009 
1010         --  Debug flag gnatd7 suppresses this copyright notice
1011 
1012         and then not Debug_Flag_7
1013       then
1014          Write_Eol;
1015          Write_Str ("GNAT ");
1016          Write_Str (Gnat_Version_String);
1017          Write_Eol;
1018          Write_Str ("Copyright 1992-" & Current_Year
1019                     & ", Free Software Foundation, Inc.");
1020          Write_Eol;
1021       end if;
1022 
1023       --  Check we do not have more than one source file, this happens only in
1024       --  the case where the driver is called directly, it cannot happen when
1025       --  gnat1 is invoked from gcc in the normal case.
1026 
1027       if Osint.Number_Of_Files /= 1 then
1028          Usage;
1029          Write_Eol;
1030          Osint.Fail ("you must provide one source file");
1031 
1032       elsif Usage_Requested then
1033          Usage;
1034       end if;
1035 
1036       --  Generate target dependent output file if requested
1037 
1038       if Target_Dependent_Info_Write_Name /= null then
1039          Set_Targ.Write_Target_Dependent_Values;
1040       end if;
1041 
1042       --  Call the front end
1043 
1044       Original_Operating_Mode := Operating_Mode;
1045       Frontend;
1046 
1047       --  In GNATprove mode, force loading of System unit to ensure that
1048       --  System.Interrupt_Priority is available to GNATprove for the
1049       --  generation of VCs related to ceiling priority.
1050 
1051       if GNATprove_Mode then
1052          declare
1053             Unused_E : constant Entity_Id :=
1054                          Rtsfind.RTE (Rtsfind.RE_Interrupt_Priority);
1055          begin
1056             null;
1057          end;
1058       end if;
1059 
1060       --  Exit with errors if the main source could not be parsed
1061 
1062       if Sinput.Main_Source_File = No_Source_File then
1063          Errout.Finalize (Last_Call => True);
1064          Errout.Output_Messages;
1065          Exit_Program (E_Errors);
1066       end if;
1067 
1068       Main_Unit_Node := Cunit (Main_Unit);
1069       Main_Kind := Nkind (Unit (Main_Unit_Node));
1070       Check_Bad_Body;
1071 
1072       --  In CodePeer mode we always delete old SCIL files before regenerating
1073       --  new ones, in case of e.g. errors, and also to remove obsolete scilx
1074       --  files generated by CodePeer itself.
1075 
1076       if CodePeer_Mode then
1077          Comperr.Delete_SCIL_Files;
1078       end if;
1079 
1080       --  Ditto for old C files before regenerating new ones
1081 
1082       if Generate_C_Code then
1083          Delete_C_File;
1084          Delete_H_File;
1085       end if;
1086 
1087       --  Exit if compilation errors detected
1088 
1089       Errout.Finalize (Last_Call => False);
1090 
1091       if Compilation_Errors then
1092          Treepr.Tree_Dump;
1093          Post_Compilation_Validation_Checks;
1094          Errout.Output_Messages;
1095          Namet.Finalize;
1096 
1097          --  Generate ALI file if specially requested
1098 
1099          if Opt.Force_ALI_Tree_File then
1100             Write_ALI (Object => False);
1101             Tree_Gen;
1102          end if;
1103 
1104          Errout.Finalize (Last_Call => True);
1105          Exit_Program (E_Errors);
1106       end if;
1107 
1108       --  Set Generate_Code on main unit and its spec. We do this even if are
1109       --  not generating code, since Lib-Writ uses this to determine which
1110       --  units get written in the ali file.
1111 
1112       Set_Generate_Code (Main_Unit);
1113 
1114       --  If we have a corresponding spec, and it comes from source or it is
1115       --  not a generated spec for a child subprogram body, then we need object
1116       --  code for the spec unit as well.
1117 
1118       if Nkind (Unit (Main_Unit_Node)) in N_Unit_Body
1119         and then not Acts_As_Spec (Main_Unit_Node)
1120       then
1121          if Nkind (Unit (Main_Unit_Node)) = N_Subprogram_Body
1122            and then not Comes_From_Source (Library_Unit (Main_Unit_Node))
1123          then
1124             null;
1125          else
1126             Set_Generate_Code
1127               (Get_Cunit_Unit_Number (Library_Unit (Main_Unit_Node)));
1128          end if;
1129       end if;
1130 
1131       --  Case of no code required to be generated, exit indicating no error
1132 
1133       if Original_Operating_Mode = Check_Syntax then
1134          Treepr.Tree_Dump;
1135          Errout.Finalize (Last_Call => True);
1136          Errout.Output_Messages;
1137          Tree_Gen;
1138          Namet.Finalize;
1139          Check_Rep_Info;
1140 
1141          --  Use a goto instead of calling Exit_Program so that finalization
1142          --  occurs normally.
1143 
1144          goto End_Of_Program;
1145 
1146       elsif Original_Operating_Mode = Check_Semantics then
1147          Back_End_Mode := Declarations_Only;
1148 
1149       --  All remaining cases are cases in which the user requested that code
1150       --  be generated (i.e. no -gnatc or -gnats switch was used). Check if we
1151       --  can in fact satisfy this request.
1152 
1153       --  Cannot generate code if someone has turned off code generation for
1154       --  any reason at all. We will try to figure out a reason below.
1155 
1156       elsif Operating_Mode /= Generate_Code then
1157          Back_End_Mode := Skip;
1158 
1159       --  We can generate code for a subprogram body unless there were missing
1160       --  subunits. Note that we always generate code for all generic units (a
1161       --  change from some previous versions of GNAT).
1162 
1163       elsif Main_Kind = N_Subprogram_Body and then not Subunits_Missing then
1164          Back_End_Mode := Generate_Object;
1165 
1166       --  We can generate code for a package body unless there are subunits
1167       --  missing (note that we always generate code for generic units, which
1168       --  is a change from some earlier versions of GNAT).
1169 
1170       elsif Main_Kind = N_Package_Body and then not Subunits_Missing then
1171          Back_End_Mode := Generate_Object;
1172 
1173       --  We can generate code for a package declaration or a subprogram
1174       --  declaration only if it does not required a body.
1175 
1176       elsif Nkind_In (Main_Kind, N_Package_Declaration,
1177                                  N_Subprogram_Declaration)
1178         and then
1179           (not Body_Required (Main_Unit_Node)
1180              or else Distribution_Stub_Mode = Generate_Caller_Stub_Body)
1181       then
1182          Back_End_Mode := Generate_Object;
1183 
1184       --  We can generate code for a generic package declaration of a generic
1185       --  subprogram declaration only if does not require a body.
1186 
1187       elsif Nkind_In (Main_Kind, N_Generic_Package_Declaration,
1188                                  N_Generic_Subprogram_Declaration)
1189         and then not Body_Required (Main_Unit_Node)
1190       then
1191          Back_End_Mode := Generate_Object;
1192 
1193       --  Compilation units that are renamings do not require bodies, so we can
1194       --  generate code for them.
1195 
1196       elsif Nkind_In (Main_Kind, N_Package_Renaming_Declaration,
1197                                  N_Subprogram_Renaming_Declaration)
1198       then
1199          Back_End_Mode := Generate_Object;
1200 
1201       --  Compilation units that are generic renamings do not require bodies
1202       --  so we can generate code for them.
1203 
1204       elsif Main_Kind in N_Generic_Renaming_Declaration then
1205          Back_End_Mode := Generate_Object;
1206 
1207       --  It is not an error to analyze in CodePeer mode a spec which requires
1208       --  a body, in order to generate SCIL for this spec.
1209       --  Ditto for Generate_C_Code mode and generate a C header for a spec.
1210 
1211       elsif CodePeer_Mode or Generate_C_Code then
1212          Back_End_Mode := Generate_Object;
1213 
1214       --  It is not an error to analyze in GNATprove mode a spec which requires
1215       --  a body, when the body is not available. During frame condition
1216       --  generation, the corresponding ALI file is generated. During
1217       --  analysis, the spec is analyzed.
1218 
1219       elsif GNATprove_Mode then
1220          Back_End_Mode := Declarations_Only;
1221 
1222       --  In all other cases (specs which have bodies, generics, and bodies
1223       --  where subunits are missing), we cannot generate code and we generate
1224       --  a warning message. Note that generic instantiations are gone at this
1225       --  stage since they have been replaced by their instances.
1226 
1227       else
1228          Back_End_Mode := Skip;
1229       end if;
1230 
1231       --  At this stage Back_End_Mode is set to indicate if the backend should
1232       --  be called to generate code. If it is Skip, then code generation has
1233       --  been turned off, even though code was requested by the original
1234       --  command. This is not an error from the user point of view, but it is
1235       --  an error from the point of view of the gcc driver, so we must exit
1236       --  with an error status.
1237 
1238       --  We generate an informative message (from the gcc point of view, it
1239       --  is an error message, but from the users point of view this is not an
1240       --  error, just a consequence of compiling something that cannot
1241       --  generate code).
1242 
1243       if Back_End_Mode = Skip then
1244          Set_Standard_Error;
1245          Write_Str ("cannot generate code for file ");
1246          Write_Name (Unit_File_Name (Main_Unit));
1247 
1248          if Subunits_Missing then
1249             Write_Str (" (missing subunits)");
1250             Write_Eol;
1251 
1252             --  Force generation of ALI file, for backward compatibility
1253 
1254             Opt.Force_ALI_Tree_File := True;
1255 
1256          elsif Main_Kind = N_Subunit then
1257             Write_Str (" (subunit)");
1258             Write_Eol;
1259 
1260             --  Force generation of ALI file, for backward compatibility
1261 
1262             Opt.Force_ALI_Tree_File := True;
1263 
1264          elsif Main_Kind = N_Subprogram_Declaration then
1265             Write_Str (" (subprogram spec)");
1266             Write_Eol;
1267 
1268          --  Generic package body in GNAT implementation mode
1269 
1270          elsif Main_Kind = N_Package_Body and then GNAT_Mode then
1271             Write_Str (" (predefined generic)");
1272             Write_Eol;
1273 
1274             --  Force generation of ALI file, for backward compatibility
1275 
1276             Opt.Force_ALI_Tree_File := True;
1277 
1278          --  Only other case is a package spec
1279 
1280          else
1281             Write_Str (" (package spec)");
1282             Write_Eol;
1283          end if;
1284 
1285          Set_Standard_Output;
1286 
1287          Post_Compilation_Validation_Checks;
1288          Errout.Finalize (Last_Call => True);
1289          Errout.Output_Messages;
1290          Treepr.Tree_Dump;
1291          Tree_Gen;
1292 
1293          --  Generate ALI file if specially requested, or for missing subunits,
1294          --  subunits or predefined generic.
1295 
1296          if Opt.Force_ALI_Tree_File then
1297             Write_ALI (Object => False);
1298          end if;
1299 
1300          Namet.Finalize;
1301          Check_Rep_Info;
1302 
1303          --  Exit program with error indication, to kill object file
1304 
1305          Exit_Program (E_No_Code);
1306       end if;
1307 
1308       --  In -gnatc mode, we only do annotation if -gnatt or -gnatR is also set
1309       --  as indicated by Back_Annotate_Rep_Info being set to True.
1310 
1311       --  We don't call for annotations on a subunit, because to process those
1312       --  the back end requires that the parent(s) be properly compiled.
1313 
1314       --  Annotation is suppressed for targets where front-end layout is
1315       --  enabled, because the front end determines representations.
1316 
1317       --  The back end is not invoked in ASIS mode with GNSA because all type
1318       --  representation information will be provided by the GNSA back end, not
1319       --  gigi.
1320 
1321       if Back_End_Mode = Declarations_Only
1322         and then
1323           (not (Back_Annotate_Rep_Info or Generate_SCIL or GNATprove_Mode)
1324             or else Main_Kind = N_Subunit
1325             or else Frontend_Layout_On_Target
1326             or else ASIS_GNSA_Mode)
1327       then
1328          Post_Compilation_Validation_Checks;
1329          Errout.Finalize (Last_Call => True);
1330          Errout.Output_Messages;
1331          Write_ALI (Object => False);
1332          Tree_Dump;
1333          Tree_Gen;
1334          Namet.Finalize;
1335          Check_Rep_Info;
1336          return;
1337       end if;
1338 
1339       --  Ensure that we properly register a dependency on system.ads, since
1340       --  even if we do not semantically depend on this, Targparm has read
1341       --  system parameters from the system.ads file.
1342 
1343       Lib.Writ.Ensure_System_Dependency;
1344 
1345       --  Add dependencies, if any, on preprocessing data file and on
1346       --  preprocessing definition file(s).
1347 
1348       Prepcomp.Add_Dependencies;
1349 
1350       --  In gnatprove mode we're writing the ALI much earlier than usual
1351       --  as flow analysis needs the file present in order to append its
1352       --  own globals to it.
1353 
1354       if GNATprove_Mode then
1355 
1356          --  Note: In GNATprove mode, an "object" file is always generated as
1357          --  the result of calling gnat1 or gnat2why, although this is not the
1358          --  same as the object file produced for compilation.
1359 
1360          Write_ALI (Object => True);
1361       end if;
1362 
1363       --  Some back ends (for instance Gigi) are known to rely on SCOs for code
1364       --  generation. Make sure they are available.
1365 
1366       if Generate_SCO then
1367          Par_SCO.SCO_Record_Filtered;
1368       end if;
1369 
1370       --  Back end needs to explicitly unlock tables it needs to touch
1371 
1372       Atree.Lock;
1373       Elists.Lock;
1374       Fname.UF.Lock;
1375       Ghost.Lock;
1376       Inline.Lock;
1377       Lib.Lock;
1378       Namet.Lock;
1379       Nlists.Lock;
1380       Sem.Lock;
1381       Sinput.Lock;
1382       Stringt.Lock;
1383 
1384       --  Here we call the back end to generate the output code
1385 
1386       Generating_Code := True;
1387 
1388       if Generate_C_Code then
1389          Elists.Unlock;
1390          Namet.Unlock;
1391          Cprint.Source_Dump;
1392       else
1393          Back_End.Call_Back_End (Back_End_Mode);
1394 
1395          --  Once the backend is complete, we unlock the names table. This call
1396          --  allows a few extra entries, needed for example for the file name
1397          --  for the library file output.
1398 
1399          Namet.Unlock;
1400       end if;
1401 
1402       --  Generate the call-graph output of dispatching calls
1403 
1404       Exp_CG.Generate_CG_Output;
1405 
1406       --  Perform post compilation validation checks
1407 
1408       Post_Compilation_Validation_Checks;
1409 
1410       --  Now we complete output of errors, rep info and the tree info. These
1411       --  are delayed till now, since it is perfectly possible for gigi to
1412       --  generate errors, modify the tree (in particular by setting flags
1413       --  indicating that elaboration is required, and also to back annotate
1414       --  representation information for List_Rep_Info.
1415 
1416       Errout.Finalize (Last_Call => True);
1417       Errout.Output_Messages;
1418       List_Rep_Info (Ttypes.Bytes_Big_Endian);
1419       Inline.List_Inlining_Info;
1420 
1421       --  Only write the library if the backend did not generate any error
1422       --  messages. Otherwise signal errors to the driver program so that
1423       --  there will be no attempt to generate an object file.
1424 
1425       if Compilation_Errors then
1426          Treepr.Tree_Dump;
1427          Exit_Program (E_Errors);
1428       end if;
1429 
1430       if not GNATprove_Mode then
1431          Write_ALI (Object => (Back_End_Mode = Generate_Object));
1432       end if;
1433 
1434       if not Compilation_Errors then
1435 
1436          --  In case of ada backends, we need to make sure that the generated
1437          --  object file has a timestamp greater than the ALI file. We do this
1438          --  to make gnatmake happy when checking the ALI and obj timestamps,
1439          --  where it expects the object file being written after the ali file.
1440 
1441          --  Gnatmake's assumption is true for gcc platforms where the gcc
1442          --  wrapper needs to call the assembler after calling gnat1, but is
1443          --  not true for ada backends, where the object files are created
1444          --  directly by gnat1 (so are created before the ali file).
1445 
1446          Back_End.Gen_Or_Update_Object_File;
1447       end if;
1448 
1449       --  Generate ASIS tree after writing the ALI file, since in ASIS mode,
1450       --  Write_ALI may in fact result in further tree decoration from the
1451       --  original tree file. Note that we dump the tree just before generating
1452       --  it, so that the dump will exactly reflect what is written out.
1453 
1454       Treepr.Tree_Dump;
1455       Tree_Gen;
1456 
1457       --  Finalize name table and we are all done
1458 
1459       Namet.Finalize;
1460 
1461    exception
1462       --  Handle fatal internal compiler errors
1463 
1464       when Rtsfind.RE_Not_Available =>
1465          Comperr.Compiler_Abort ("RE_Not_Available");
1466 
1467       when System.Assertions.Assert_Failure =>
1468          Comperr.Compiler_Abort ("Assert_Failure");
1469 
1470       when Constraint_Error =>
1471          Comperr.Compiler_Abort ("Constraint_Error");
1472 
1473       when Program_Error =>
1474          Comperr.Compiler_Abort ("Program_Error");
1475 
1476       when Storage_Error =>
1477 
1478          --  Assume this is a bug. If it is real, the message will in any case
1479          --  say Storage_Error, giving a strong hint.
1480 
1481          Comperr.Compiler_Abort ("Storage_Error");
1482 
1483       when Unrecoverable_Error =>
1484          raise;
1485 
1486       when others =>
1487          Comperr.Compiler_Abort ("exception");
1488    end;
1489 
1490    <<End_Of_Program>>
1491    null;
1492 
1493    --  The outer exception handles an unrecoverable error
1494 
1495 exception
1496    when Unrecoverable_Error =>
1497       Errout.Finalize (Last_Call => True);
1498       Errout.Output_Messages;
1499 
1500       Set_Standard_Error;
1501       Write_Str ("compilation abandoned");
1502       Write_Eol;
1503 
1504       Set_Standard_Output;
1505       Source_Dump;
1506       Tree_Dump;
1507       Exit_Program (E_Errors);
1508 
1509 end Gnat1drv;