CbC/CbC_gcc: gcc/ada/gnat1drv.adb comparison

comparison gcc/ada/gnat1drv.adb @ 111:04ced10e8804

gcc 7

author	kono
date	Fri, 27 Oct 2017 22:46:09 +0900
parents
children	84e7813d76e9

comparison

equal deleted inserted replaced

-:561a7518be6b
+:04ced10e8804
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             G N A T 1 D R V                              --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--          Copyright (C) 1992-2017, Free Software Foundation, Inc.         --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license.          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+with Atree;     use Atree;
+with Back_End;  use Back_End;
+with Checks;
+with Comperr;
+with Csets;
+with Debug;     use Debug;
+with Elists;
+with Errout;    use Errout;
+with Exp_CG;
+with Fmap;
+with Fname;     use Fname;
+with Fname.UF;  use Fname.UF;
+with Frontend;
+with Ghost;     use Ghost;
+with Gnatvsn;   use Gnatvsn;
+with Inline;
+with Lib;       use Lib;
+with Lib.Writ;  use Lib.Writ;
+with Lib.Xref;
+with Namet;     use Namet;
+with Nlists;
+with Opt;       use Opt;
+with Osint;     use Osint;
+with Osint.C;   use Osint.C;
+with Output;    use Output;
+with Par_SCO;
+with Prepcomp;
+with Repinfo;   use Repinfo;
+with Restrict;
+with Rident;    use Rident;
+with Rtsfind;
+with SCOs;
+with Sem;
+with Sem_Ch8;
+with Sem_Ch12;
+with Sem_Ch13;
+with Sem_Elim;
+with Sem_Eval;
+with Sem_SPARK; use Sem_SPARK;
+with Sem_Type;
+with Set_Targ;
+with Sinfo;     use Sinfo;
+with Sinput.L;  use Sinput.L;
+with Snames;    use Snames;
+with Sprint;    use Sprint;
+with Stringt;
+with Stylesw;   use Stylesw;
+with Targparm;  use Targparm;
+with Tbuild;
+with Tree_Gen;
+with Treepr;    use Treepr;
+with Ttypes;
+with Types;     use Types;
+with Uintp;
+with Uname;     use Uname;
+with Urealp;
+with Usage;
+with Validsw;   use Validsw;
+with System.Assertions;
+with System.OS_Lib;
+--------------
+-- Gnat1drv --
+--------------
+procedure Gnat1drv is
+procedure Adjust_Global_Switches;
+--  There are various interactions between front-end switch settings,
+--  including debug switch settings and target dependent parameters.
+--  This procedure takes care of properly handling these interactions.
+--  We do it after scanning out all the switches, so that we are not
+--  depending on the order in which switches appear.
+procedure Check_Bad_Body (Unit_Node : Node_Id; Unit_Kind : Node_Kind);
+--  Called to check whether a unit described by its compilation unit node
+--  and kind has a bad body.
+procedure Check_Rep_Info;
+--  Called when we are not generating code, to check if -gnatR was requested
+--  and if so, explain that we will not be honoring the request.
+procedure Post_Compilation_Validation_Checks;
+--  This procedure performs various validation checks that have to be left
+--  to the end of the compilation process, after generating code but before
+--  issuing error messages. In particular, these checks generally require
+--  the information provided by the back end in back annotation of declared
+--  entities (e.g. actual size and alignment values chosen by the back end).
+----------------------------
+-- Adjust_Global_Switches --
+----------------------------
+procedure Adjust_Global_Switches is
+procedure SPARK_Library_Warning (Kind : String);
+--  Issue a warning in GNATprove mode if the run-time library does not
+--  fully support IEEE-754 floating-point semantics.
+---------------------------
+-- SPARK_Library_Warning --
+---------------------------
+procedure SPARK_Library_Warning (Kind : String) is
+begin
+Write_Line
+("warning: run-time library may be configured incorrectly");
+Write_Line
+("warning: (SPARK analysis requires support for " & Kind & ')');
+end SPARK_Library_Warning;
+--  Start of processing for Adjust_Global_Switches
+begin
+--  -gnatd.M enables Relaxed_RM_Semantics
+if Debug_Flag_Dot_MM then
+Relaxed_RM_Semantics := True;
+end if;
+--  -gnatd.1 enables unnesting of subprograms
+if Debug_Flag_Dot_1 then
+Unnest_Subprogram_Mode := True;
+end if;
+--  -gnatd.u enables special C expansion mode
+if Debug_Flag_Dot_U then
+Modify_Tree_For_C := True;
+end if;
+--  Set all flags required when generating C code
+if Generate_C_Code then
+Modify_Tree_For_C := True;
+Unnest_Subprogram_Mode := True;
+Minimize_Expression_With_Actions := True;
+--  Set operating mode to Generate_Code to benefit from full front-end
+--  expansion (e.g. generics).
+Operating_Mode := Generate_Code;
+--  Suppress alignment checks since we do not have access to alignment
+--  info on the target.
+Suppress_Options.Suppress (Alignment_Check) := False;
+end if;
+--  -gnatd.E sets Error_To_Warning mode, causing selected error messages
+--  to be treated as warnings instead of errors.
+if Debug_Flag_Dot_EE then
+Error_To_Warning := True;
+end if;
+--  -gnatdJ sets Include_Subprogram_In_Messages, adding the related
+--  subprogram as part of the error and warning messages.
+if Debug_Flag_JJ then
+Include_Subprogram_In_Messages := True;
+end if;
+--  Disable CodePeer_Mode in Check_Syntax, since we need front-end
+--  expansion.
+if Operating_Mode = Check_Syntax then
+CodePeer_Mode := False;
+end if;
+--  Set ASIS mode if -gnatt and -gnatc are set
+if Operating_Mode = Check_Semantics and then Tree_Output then
+ASIS_Mode := True;
+--  Set ASIS GNSA mode if -gnatd.H is set
+if Debug_Flag_Dot_HH then
+ASIS_GNSA_Mode := True;
+end if;
+--  Turn off inlining in ASIS mode, since ASIS cannot handle the extra
+--  information in the trees caused by inlining being active.
+--  More specifically, the tree seems to be malformed from the ASIS
+--  point of view if -gnatc and -gnatn appear together???
+Inline_Active := False;
+--  Turn off SCIL generation and CodePeer mode in semantics mode,
+--  since SCIL requires front-end expansion.
+Generate_SCIL := False;
+CodePeer_Mode := False;
+end if;
+--  SCIL mode needs to disable front-end inlining since the generated
+--  trees (in particular order and consistency between specs compiled
+--  as part of a main unit or as part of a with-clause) are causing
+--  troubles.
+if Generate_SCIL then
+Front_End_Inlining := False;
+end if;
+--  Tune settings for optimal SCIL generation in CodePeer mode
+if CodePeer_Mode then
+--  Turn off gnatprove mode (which can be set via e.g. -gnatd.F), not
+--  compatible with CodePeer mode.
+GNATprove_Mode := False;
+Debug_Flag_Dot_FF := False;
+--  Turn off C tree generation, not compatible with CodePeer mode. We
+--  do not expect this to happen in normal use, since both modes are
+--  enabled by special tools, but it is useful to turn off these flags
+--  this way when we are doing CodePeer tests on existing test suites
+--  that may have -gnateg set, to avoid the need for special casing.
+Modify_Tree_For_C := False;
+Generate_C_Code := False;
+Unnest_Subprogram_Mode := False;
+--  Turn off inlining, confuses CodePeer output and gains nothing
+Front_End_Inlining := False;
+Inline_Active      := False;
+--  Disable front-end optimizations, to keep the tree as close to the
+--  source code as possible, and also to avoid inconsistencies between
+--  trees when using different optimization switches.
+Optimization_Level := 0;
+--  Enable some restrictions systematically to simplify the generated
+--  code (and ease analysis). Note that restriction checks are also
+--  disabled in CodePeer mode, see Restrict.Check_Restriction, and
+--  user specified Restrictions pragmas are ignored, see
+--  Sem_Prag.Process_Restrictions_Or_Restriction_Warnings.
+Restrict.Restrictions.Set   (No_Exception_Registration)       := True;
+Restrict.Restrictions.Set   (No_Initialize_Scalars)           := True;
+Restrict.Restrictions.Set   (No_Task_Hierarchy)               := True;
+Restrict.Restrictions.Set   (No_Abort_Statements)             := True;
+Restrict.Restrictions.Set   (Max_Asynchronous_Select_Nesting) := True;
+Restrict.Restrictions.Value (Max_Asynchronous_Select_Nesting) := 0;
+--  Enable pragma Ignore_Pragma (Global) to support legacy code. As a
+--  consequence, Refined_Global pragma should be ignored as well, as
+--  it is only allowed on a body when pragma Global is given for the
+--  spec.
+Set_Name_Table_Boolean3 (Name_Global, True);
+Set_Name_Table_Boolean3 (Name_Refined_Global, True);
+--  Suppress division by zero checks since they are handled
+--  implicitly by CodePeer.
+--  Turn off dynamic elaboration checks: generates inconsistencies in
+--  trees between specs compiled as part of a main unit or as part of
+--  a with-clause.
+--  Turn off alignment checks: these cannot be proved statically by
+--  CodePeer and generate false positives.
+--  Enable all other language checks
+Suppress_Options.Suppress :=
+(Alignment_Check   => True,
+Division_Check    => True,
+Elaboration_Check => True,
+others            => False);
+Dynamic_Elaboration_Checks := False;
+--  Set STRICT mode for overflow checks if not set explicitly. This
+--  prevents suppressing of overflow checks by default, in code down
+--  below.
+if Suppress_Options.Overflow_Mode_General = Not_Set then
+Suppress_Options.Overflow_Mode_General    := Strict;
+Suppress_Options.Overflow_Mode_Assertions := Strict;
+end if;
+--  CodePeer handles division and overflow checks directly, based on
+--  the marks set by the frontend, hence no special expansion should
+--  be performed in the frontend for division and overflow checks.
+Backend_Divide_Checks_On_Target   := True;
+Backend_Overflow_Checks_On_Target := True;
+--  Kill debug of generated code, since it messes up sloc values
+Debug_Generated_Code := False;
+--  Ditto for -gnateG which interacts badly with handling of pragma
+--  Annotate in gnat2scil.
+Generate_Processed_File := False;
+--  Disable Exception_Extra_Info (-gnateE) which generates more
+--  complex trees with no added value, and may confuse CodePeer.
+Exception_Extra_Info := False;
+--  Turn cross-referencing on in case it was disabled (e.g. by -gnatD)
+--  to support source navigation.
+Xref_Active := True;
+--  Polling mode forced off, since it generates confusing junk
+Polling_Required := False;
+--  Set operating mode to Generate_Code to benefit from full front-end
+--  expansion (e.g. generics).
+Operating_Mode := Generate_Code;
+--  We need SCIL generation of course
+Generate_SCIL := True;
+--  Enable assertions, since they give CodePeer valuable extra info
+Assertions_Enabled := True;
+--  Set normal RM validity checking and checking of copies (to catch
+--  e.g. wrong values used in unchecked conversions).
+--  All other validity checking is turned off, since this can generate
+--  very complex trees that only confuse CodePeer and do not bring
+--  enough useful info.
+Reset_Validity_Check_Options;
+Validity_Check_Default       := True;
+Validity_Check_Copies        := True;
+Check_Validity_Of_Parameters := False;
+--  Turn off style check options and ignore any style check pragmas
+--  since we are not interested in any front-end warnings when we are
+--  getting CodePeer output.
+Reset_Style_Check_Options;
+Ignore_Style_Checks_Pragmas := True;
+--  Always perform semantics and generate ali files in CodePeer mode,
+--  so that a gnatmake -c -k will proceed further when possible.
+Force_ALI_Tree_File := True;
+Try_Semantics := True;
+--  Make the Ada front end more liberal so that the compiler will
+--  allow illegal code that is allowed by other compilers. CodePeer
+--  is in the business of finding problems, not enforcing rules.
+--  This is useful when using CodePeer mode with other compilers.
+Relaxed_RM_Semantics := True;
+--  Disable all simple value propagation. This is an optimization
+--  which is valuable for code optimization, and also for generation
+--  of compiler warnings, but these are being turned off by default,
+--  and CodePeer generates better messages (referencing original
+--  variables) this way.
+--  Do this only if -gnatws is set (the default with -gnatcC), so that
+--  if warnings are enabled, we'll get better messages from GNAT.
+if Warning_Mode = Suppress then
+Debug_Flag_MM := True;
+end if;
+end if;
+--  Enable some individual switches that are implied by relaxed RM
+--  semantics mode.
+if Relaxed_RM_Semantics then
+Opt.Allow_Integer_Address := True;
+Overriding_Renamings := True;
+Treat_Categorization_Errors_As_Warnings := True;
+end if;
+--  Enable GNATprove_Mode when using -gnatd.F switch
+if Debug_Flag_Dot_FF then
+GNATprove_Mode := True;
+end if;
+--  GNATprove_Mode is also activated by default in the gnat2why
+--  executable.
+if GNATprove_Mode then
+--  Turn off CodePeer mode (which can be set via e.g. -gnatC or
+--  -gnateC), not compatible with GNATprove mode.
+CodePeer_Mode := False;
+Generate_SCIL := False;
+--  Turn off C tree generation, not compatible with GNATprove mode. We
+--  do not expect this to happen in normal use, since both modes are
+--  enabled by special tools, but it is useful to turn off these flags
+--  this way when we are doing GNATprove tests on existing test suites
+--  that may have -gnateg set, to avoid the need for special casing.
+Modify_Tree_For_C := False;
+Generate_C_Code := False;
+Unnest_Subprogram_Mode := False;
+--  Turn off inlining, which would confuse formal verification output
+--  and gain nothing.
+Front_End_Inlining := False;
+Inline_Active      := False;
+--  Issue warnings for failure to inline subprograms, as otherwise
+--  expected in GNATprove mode for the local subprograms without
+--  contracts.
+Ineffective_Inline_Warnings := True;
+--  Disable front-end optimizations, to keep the tree as close to the
+--  source code as possible, and also to avoid inconsistencies between
+--  trees when using different optimization switches.
+Optimization_Level := 0;
+--  Enable some restrictions systematically to simplify the generated
+--  code (and ease analysis).
+Restrict.Restrictions.Set (No_Initialize_Scalars) := True;
+--  Note: at this point we used to suppress various checks, but that
+--  is not what we want. We need the semantic processing for these
+--  checks (which will set flags like Do_Overflow_Check, showing the
+--  points at which potential checks are required semantically). We
+--  don't want the expansion associated with these checks, but that
+--  happens anyway because this expansion is simply not done in the
+--  SPARK version of the expander.
+--  On the contrary, we need to enable explicitly all language checks,
+--  as they may have been suppressed by the use of switch -gnatp.
+Suppress_Options.Suppress := (others => False);
+--  Detect overflow on unconstrained floating-point types, such as
+--  the predefined types Float, Long_Float and Long_Long_Float from
+--  package Standard. Not necessary if float overflows are checked
+--  (Machine_Overflow true), since appropriate Do_Overflow_Check flags
+--  will be set in any case.
+Check_Float_Overflow := not Machine_Overflows_On_Target;
+--  Set STRICT mode for overflow checks if not set explicitly. This
+--  prevents suppressing of overflow checks by default, in code down
+--  below.
+if Suppress_Options.Overflow_Mode_General = Not_Set then
+Suppress_Options.Overflow_Mode_General    := Strict;
+Suppress_Options.Overflow_Mode_Assertions := Strict;
+end if;
+--  Kill debug of generated code, since it messes up sloc values
+Debug_Generated_Code := False;
+--  Turn cross-referencing on in case it was disabled (e.g. by -gnatD)
+--  as it is needed for computing effects of subprograms in the formal
+--  verification backend.
+Xref_Active := True;
+--  Polling mode forced off, since it generates confusing junk
+Polling_Required := False;
+--  Set operating mode to Check_Semantics, but a light front-end
+--  expansion is still performed.
+Operating_Mode := Check_Semantics;
+--  Enable assertions, since they give valuable extra information for
+--  formal verification.
+Assertions_Enabled := True;
+--  Disable validity checks, since it generates code raising
+--  exceptions for invalid data, which confuses GNATprove. Invalid
+--  data is directly detected by GNATprove's flow analysis.
+Validity_Checks_On := False;
+Check_Validity_Of_Parameters := False;
+--  Turn off style check options since we are not interested in any
+--  front-end warnings when we are getting SPARK output.
+Reset_Style_Check_Options;
+--  Suppress the generation of name tables for enumerations, which are
+--  not needed for formal verification, and fall outside the SPARK
+--  subset (use of pointers).
+Global_Discard_Names := True;
+--  Suppress the expansion of tagged types and dispatching calls,
+--  which lead to the generation of non-SPARK code (use of pointers),
+--  which is more complex to formally verify than the original source.
+Tagged_Type_Expansion := False;
+--  Detect that the runtime library support for floating-point numbers
+--  may not be compatible with SPARK analysis of IEEE-754 floats.
+if Denorm_On_Target = False then
+SPARK_Library_Warning ("float subnormals");
+elsif Machine_Rounds_On_Target = False then
+SPARK_Library_Warning ("float rounding");
+elsif Signed_Zeros_On_Target = False then
+SPARK_Library_Warning ("signed zeros");
+end if;
+end if;
+--  Set Configurable_Run_Time mode if system.ads flag set or if the
+--  special debug flag -gnatdY is set.
+if Targparm.Configurable_Run_Time_On_Target or Debug_Flag_YY then
+Configurable_Run_Time_Mode := True;
+end if;
+--  Set -gnatRm mode if debug flag A set
+if Debug_Flag_AA then
+Back_Annotate_Rep_Info := True;
+List_Representation_Info := 1;
+List_Representation_Info_Mechanisms := True;
+end if;
+--  Force Target_Strict_Alignment true if debug flag -gnatd.a is set
+if Debug_Flag_Dot_A then
+Ttypes.Target_Strict_Alignment := True;
+end if;
+--  Increase size of allocated entities if debug flag -gnatd.N is set
+if Debug_Flag_Dot_NN then
+Atree.Num_Extension_Nodes := Atree.Num_Extension_Nodes + 1;
+end if;
+--  Disable static allocation of dispatch tables if -gnatd.t is enabled.
+--  The front end's layout phase currently treats types that have
+--  discriminant-dependent arrays as not being static even when a
+--  discriminant constraint on the type is static, and this leads to
+--  problems with subtypes of type Ada.Tags.Dispatch_Table_Wrapper. ???
+if Debug_Flag_Dot_T then
+Static_Dispatch_Tables := False;
+end if;
+--  Flip endian mode if -gnatd8 set
+if Debug_Flag_8 then
+Ttypes.Bytes_Big_Endian := not Ttypes.Bytes_Big_Endian;
+end if;
+--  Set and check exception mechanism. This is only meaningful when
+--  compiling, and in particular not meaningful for special modes used
+--  for program analysis rather than compilation: ASIS mode, CodePeer
+--  mode and GNATprove mode.
+if Operating_Mode = Generate_Code
+and then not (ASIS_Mode or CodePeer_Mode or GNATprove_Mode)
+then
+case Targparm.Frontend_Exceptions_On_Target is
+when True =>
+case Targparm.ZCX_By_Default_On_Target is
+when True =>
+Write_Line
+("Run-time library configured incorrectly");
+Write_Line
+("(requesting support for Frontend ZCX exceptions)");
+raise Unrecoverable_Error;
+when False =>
+Exception_Mechanism := Front_End_SJLJ;
+end case;
+when False =>
+case Targparm.ZCX_By_Default_On_Target is
+when True =>
+Exception_Mechanism := Back_End_ZCX;
+when False =>
+Exception_Mechanism := Back_End_SJLJ;
+end case;
+end case;
+end if;
+--  Set proper status for overflow check mechanism
+--  If already set (by -gnato or above in SPARK or CodePeer mode) then we
+--  have nothing to do.
+if Opt.Suppress_Options.Overflow_Mode_General /= Not_Set then
+null;
+--  Otherwise set overflow mode defaults
+else
+--  Overflow checks are on by default (Suppress set False) except in
+--  GNAT_Mode, where we want them off by default (we are not ready to
+--  enable overflow checks in the compiler yet, for one thing the case
+--  of 64-bit checks needs System.Arith_64 which is not a compiler
+--  unit and it is a pain to try to include it in the compiler.
+Suppress_Options.Suppress (Overflow_Check) := GNAT_Mode;
+--  Set appropriate default overflow handling mode. Note: at present
+--  we set STRICT in all three of the following cases. They are
+--  separated because in the future we may make different choices.
+--  By default set STRICT mode if -gnatg in effect
+if GNAT_Mode then
+Suppress_Options.Overflow_Mode_General    := Strict;
+Suppress_Options.Overflow_Mode_Assertions := Strict;
+--  If we have backend divide and overflow checks, then by default
+--  overflow checks are STRICT. Historically this code used to also
+--  activate overflow checks, although no target currently has these
+--  flags set, so this was dead code anyway.
+elsif Targparm.Backend_Divide_Checks_On_Target
+and
+Targparm.Backend_Overflow_Checks_On_Target
+then
+Suppress_Options.Overflow_Mode_General    := Strict;
+Suppress_Options.Overflow_Mode_Assertions := Strict;
+--  Otherwise for now, default is STRICT mode. This may change in the
+--  future, but for now this is the compatible behavior with previous
+--  versions of GNAT.
+else
+Suppress_Options.Overflow_Mode_General    := Strict;
+Suppress_Options.Overflow_Mode_Assertions := Strict;
+end if;
+end if;
+--  Set default for atomic synchronization. As this synchronization
+--  between atomic accesses can be expensive, and not typically needed
+--  on some targets, an optional target parameter can turn the option
+--  off. Note Atomic Synchronization is implemented as check.
+Suppress_Options.Suppress (Atomic_Synchronization) :=
+not Atomic_Sync_Default_On_Target;
+--  Set default for Alignment_Check, if we are on a machine with non-
+--  strict alignment, then we suppress this check, since it is over-
+--  zealous for such machines.
+if not Ttypes.Target_Strict_Alignment then
+Suppress_Options.Suppress (Alignment_Check) := True;
+end if;
+--  Set switch indicating if back end can handle limited types, and
+--  guarantee that no incorrect copies are made (e.g. in the context
+--  of an if or case expression).
+--  Debug flag -gnatd.L decisively sets usage on
+if Debug_Flag_Dot_LL then
+Back_End_Handles_Limited_Types := True;
+--  If no debug flag, usage off for SCIL cases
+elsif Generate_SCIL then
+Back_End_Handles_Limited_Types := False;
+--  Otherwise normal gcc back end, for now still turn flag off by
+--  default, since there are unresolved problems in the front end.
+else
+Back_End_Handles_Limited_Types := False;
+end if;
+--  If the inlining level has not been set by the user, compute it from
+--  the optimization level: 1 at -O1/-O2 (and -Os), 2 at -O3 and above.
+if Inline_Level = 0 then
+if Optimization_Level < 3 then
+Inline_Level := 1;
+else
+Inline_Level := 2;
+end if;
+end if;
+--  Treat -gnatn as equivalent to -gnatN for non-GCC targets
+if Inline_Active and not Front_End_Inlining then
+--  We really should have a tag for this, what if we added a new
+--  back end some day, it would not be true for this test, but it
+--  would be non-GCC, so this is a bit troublesome ???
+Front_End_Inlining := Generate_C_Code;
+end if;
+--  Set back-end inlining indication
+Back_End_Inlining :=
+--  No back-end inlining available on C generation
+not Generate_C_Code
+--  No back-end inlining in GNATprove mode, since it just confuses
+--  the formal verification process.
+and then not GNATprove_Mode
+--  No back-end inlining if front-end inlining explicitly enabled.
+--  Done to minimize the output differences to customers still using
+--  this deprecated switch; in addition, this behavior reduces the
+--  output differences in old tests.
+and then not Front_End_Inlining
+--  Back-end inlining is disabled if debug flag .z is set
+and then not Debug_Flag_Dot_Z;
+--  Output warning if -gnateE specified and cannot be supported
+if Exception_Extra_Info
+and then Restrict.No_Exception_Handlers_Set
+then
+Set_Standard_Error;
+Write_Str
+("warning: extra exception information (-gnateE) was specified");
+Write_Eol;
+Write_Str
+("warning: this capability is not available in this configuration");
+Write_Eol;
+Set_Standard_Output;
+end if;
+--  Finally capture adjusted value of Suppress_Options as the initial
+--  value for Scope_Suppress, which will be modified as we move from
+--  scope to scope (by Suppress/Unsuppress/Overflow_Checks pragmas).
+Sem.Scope_Suppress := Opt.Suppress_Options;
+end Adjust_Global_Switches;
+--------------------
+-- Check_Bad_Body --
+--------------------
+procedure Check_Bad_Body (Unit_Node : Node_Id; Unit_Kind : Node_Kind) is
+Fname : File_Name_Type;
+procedure Bad_Body_Error (Msg : String);
+--  Issue message for bad body found
+--------------------
+-- Bad_Body_Error --
+--------------------
+procedure Bad_Body_Error (Msg : String) is
+begin
+Error_Msg_N (Msg, Unit_Node);
+Error_Msg_File_1 := Fname;
+Error_Msg_N ("remove incorrect body in file{!", Unit_Node);
+end Bad_Body_Error;
+--  Local variables
+Sname   : Unit_Name_Type;
+Src_Ind : Source_File_Index;
+--  Start of processing for Check_Bad_Body
+begin
+--  Nothing to do if we are only checking syntax, because we don't know
+--  enough to know if we require or forbid a body in this case.
+if Operating_Mode = Check_Syntax then
+return;
+end if;
+--  Check for body not allowed
+if (Unit_Kind = N_Package_Declaration
+and then not Body_Required (Unit_Node))
+or else (Unit_Kind = N_Generic_Package_Declaration
+and then not Body_Required (Unit_Node))
+or else Unit_Kind = N_Package_Renaming_Declaration
+or else Unit_Kind = N_Subprogram_Renaming_Declaration
+or else Nkind (Original_Node (Unit (Unit_Node)))
+in N_Generic_Instantiation
+then
+Sname := Unit_Name (Main_Unit);
+--  If we do not already have a body name, then get the body name
+if not Is_Body_Name (Sname) then
+Sname := Get_Body_Name (Sname);
+end if;
+Fname := Get_File_Name (Sname, Subunit => False);
+Src_Ind := Load_Source_File (Fname);
+--  Case where body is present and it is not a subunit. Exclude the
+--  subunit case, because it has nothing to do with the package we are
+--  compiling. It is illegal for a child unit and a subunit with the
+--  same expanded name (RM 10.2(9)) to appear together in a partition,
+--  but there is nothing to stop a compilation environment from having
+--  both, and the test here simply allows that. If there is an attempt
+--  to include both in a partition, this is diagnosed at bind time. In
+--  Ada 83 mode this is not a warning case.
+--  Note that in general we do not give the message if the file in
+--  question does not look like a body. This includes weird cases,
+--  but in particular means that if the file is just a No_Body pragma,
+--  then we won't give the message (that's the whole point of this
+--  pragma, to be used this way and to cause the body file to be
+--  ignored in this context).
+if Src_Ind > No_Source_File
+and then Source_File_Is_Body (Src_Ind)
+then
+Errout.Finalize (Last_Call => False);
+Error_Msg_Unit_1 := Sname;
+--  Ada 83 case of a package body being ignored. This is not an
+--  error as far as the Ada 83 RM is concerned, but it is almost
+--  certainly not what is wanted so output a warning. Give this
+--  message only if there were no errors, since otherwise it may
+--  be incorrect (we may have misinterpreted a junk spec as not
+--  needing a body when it really does).
+if Unit_Kind = N_Package_Declaration
+and then Ada_Version = Ada_83
+and then Operating_Mode = Generate_Code
+and then Distribution_Stub_Mode /= Generate_Caller_Stub_Body
+and then not Compilation_Errors
+then
+Error_Msg_N
+("package $$ does not require a body??", Unit_Node);
+Error_Msg_File_1 := Fname;
+Error_Msg_N ("body in file{ will be ignored??", Unit_Node);
+--  Ada 95 cases of a body file present when no body is
+--  permitted. This we consider to be an error.
+else
+--  For generic instantiations, we never allow a body
+if Nkind (Original_Node (Unit (Unit_Node))) in
+N_Generic_Instantiation
+then
+Bad_Body_Error
+("generic instantiation for $$ does not allow a body");
+--  A library unit that is a renaming never allows a body
+elsif Unit_Kind in N_Renaming_Declaration then
+Bad_Body_Error
+("renaming declaration for $$ does not allow a body!");
+--  Remaining cases are packages and generic packages. Here
+--  we only do the test if there are no previous errors,
+--  because if there are errors, they may lead us to
+--  incorrectly believe that a package does not allow a
+--  body when in fact it does.
+elsif not Compilation_Errors then
+if Unit_Kind = N_Package_Declaration then
+Bad_Body_Error
+("package $$ does not allow a body!");
+elsif Unit_Kind = N_Generic_Package_Declaration then
+Bad_Body_Error
+("generic package $$ does not allow a body!");
+end if;
+end if;
+end if;
+end if;
+end if;
+end Check_Bad_Body;
+--------------------
+-- Check_Rep_Info --
+--------------------
+procedure Check_Rep_Info is
+begin
+if List_Representation_Info /= 0
+or else List_Representation_Info_Mechanisms
+then
+Set_Standard_Error;
+Write_Eol;
+Write_Str
+("cannot generate representation information, no code generated");
+Write_Eol;
+Write_Eol;
+Set_Standard_Output;
+end if;
+end Check_Rep_Info;
+----------------------------------------
+-- Post_Compilation_Validation_Checks --
+----------------------------------------
+procedure Post_Compilation_Validation_Checks is
+begin
+--  Validate alignment check warnings. In some cases we generate warnings
+--  about possible alignment errors because we don't know the alignment
+--  that will be chosen by the back end. This routine is in charge of
+--  getting rid of those warnings if we can tell they are not needed.
+Checks.Validate_Alignment_Check_Warnings;
+--  Validate compile time warnings and errors (using the values for size
+--  and alignment annotated by the backend where possible). We need to
+--  unlock temporarily these tables to reanalyze their expression.
+Atree.Unlock;
+Nlists.Unlock;
+Sem.Unlock;
+Sem_Ch13.Validate_Compile_Time_Warning_Errors;
+Sem.Lock;
+Nlists.Lock;
+Atree.Lock;
+--  Validate unchecked conversions (using the values for size and
+--  alignment annotated by the backend where possible).
+Sem_Ch13.Validate_Unchecked_Conversions;
+--  Validate address clauses (again using alignment values annotated
+--  by the backend where possible).
+Sem_Ch13.Validate_Address_Clauses;
+--  Validate independence pragmas (again using values annotated by the
+--  back end for component layout where possible) but only for non-GCC
+--  back ends, as this is done a priori for GCC back ends.
+--  ??? We use to test for AAMP_On_Target which is now gone, consider
+--
+--  if AAMP_On_Target then
+--     Sem_Ch13.Validate_Independence;
+--  end if;
+end Post_Compilation_Validation_Checks;
+--  Local variables
+Back_End_Mode : Back_End.Back_End_Mode_Type;
+Ecode         : Exit_Code_Type;
+Main_Unit_Kind : Node_Kind;
+--  Kind of main compilation unit node
+Main_Unit_Node : Node_Id;
+--  Compilation unit node for main unit
+--  Start of processing for Gnat1drv
+begin
+--  This inner block is set up to catch assertion errors and constraint
+--  errors. Since the code for handling these errors can cause another
+--  exception to be raised (namely Unrecoverable_Error), we need two
+--  nested blocks, so that the outer one handles unrecoverable error.
+begin
+--  Initialize all packages. For the most part, these initialization
+--  calls can be made in any order. Exceptions are as follows:
+--  Lib.Initialize need to be called before Scan_Compiler_Arguments,
+--  because it initializes a table filled by Scan_Compiler_Arguments.
+Osint.Initialize;
+Fmap.Reset_Tables;
+Lib.Initialize;
+Lib.Xref.Initialize;
+Scan_Compiler_Arguments;
+Osint.Add_Default_Search_Dirs;
+Atree.Initialize;
+Nlists.Initialize;
+Sinput.Initialize;
+Sem.Initialize;
+Exp_CG.Initialize;
+Csets.Initialize;
+Uintp.Initialize;
+Urealp.Initialize;
+Errout.Initialize;
+SCOs.Initialize;
+Snames.Initialize;
+Stringt.Initialize;
+Ghost.Initialize;
+Inline.Initialize;
+Par_SCO.Initialize;
+Sem_Ch8.Initialize;
+Sem_Ch12.Initialize;
+Sem_Ch13.Initialize;
+Sem_Elim.Initialize;
+Sem_Eval.Initialize;
+Sem_Type.Init_Interp_Tables;
+--  Capture compilation date and time
+Opt.Compilation_Time := System.OS_Lib.Current_Time_String;
+--  Get the target parameters only when -gnats is not used, to avoid
+--  failing when there is no default runtime.
+if Operating_Mode /= Check_Syntax then
+--  Acquire target parameters from system.ads (package System source)
+Targparm_Acquire : declare
+use Sinput;
+S : Source_File_Index;
+N : File_Name_Type;
+begin
+Name_Buffer (1 .. 10) := "system.ads";
+Name_Len := 10;
+N := Name_Find;
+S := Load_Source_File (N);
+--  Failed to read system.ads, fatal error
+if S = No_Source_File then
+Write_Line
+("fatal error, run-time library not installed correctly");
+Write_Line ("cannot locate file system.ads");
+raise Unrecoverable_Error;
+elsif S = No_Access_To_Source_File then
+Write_Line
+("fatal error, run-time library not installed correctly");
+Write_Line ("no read access for file system.ads");
+raise Unrecoverable_Error;
+--  Read system.ads successfully, remember its source index
+else
+System_Source_File_Index := S;
+end if;
+--  Call to get target parameters. Note that the actual interface
+--  routines are in Tbuild. They can't be in this procedure because
+--  of accessibility issues.
+Targparm.Get_Target_Parameters
+(System_Text  => Source_Text  (S),
+Source_First => Source_First (S),
+Source_Last  => Source_Last  (S),
+Make_Id      => Tbuild.Make_Id'Access,
+Make_SC      => Tbuild.Make_SC'Access,
+Set_NOD      => Tbuild.Set_NOD'Access,
+Set_NSA      => Tbuild.Set_NSA'Access,
+Set_NUA      => Tbuild.Set_NUA'Access,
+Set_NUP      => Tbuild.Set_NUP'Access);
+--  Acquire configuration pragma information from Targparm
+Restrict.Restrictions := Targparm.Restrictions_On_Target;
+end Targparm_Acquire;
+end if;
+--  Perform various adjustments and settings of global switches
+Adjust_Global_Switches;
+--  Output copyright notice if full list mode unless we have a list
+--  file, in which case we defer this so that it is output in the file.
+if (Verbose_Mode or else (Full_List and then Full_List_File_Name = null))
+--  Debug flag gnatd7 suppresses this copyright notice
+and then not Debug_Flag_7
+then
+Write_Eol;
+Write_Str ("GNAT ");
+Write_Str (Gnat_Version_String);
+Write_Eol;
+Write_Str ("Copyright 1992-" & Current_Year
+& ", Free Software Foundation, Inc.");
+Write_Eol;
+end if;
+--  Check we do not have more than one source file, this happens only in
+--  the case where the driver is called directly, it cannot happen when
+--  gnat1 is invoked from gcc in the normal case.
+if Osint.Number_Of_Files /= 1 then
+Usage;
+Write_Eol;
+Osint.Fail ("you must provide one source file");
+elsif Usage_Requested then
+Usage;
+end if;
+--  Generate target dependent output file if requested
+if Target_Dependent_Info_Write_Name /= null then
+Set_Targ.Write_Target_Dependent_Values;
+end if;
+--  Call the front end
+Original_Operating_Mode := Operating_Mode;
+Frontend;
+--  Exit with errors if the main source could not be parsed
+if Sinput.Main_Source_File <= No_Source_File then
+Errout.Finalize (Last_Call => True);
+Errout.Output_Messages;
+Exit_Program (E_Errors);
+end if;
+Main_Unit_Node := Cunit (Main_Unit);
+Main_Unit_Kind := Nkind (Unit (Main_Unit_Node));
+Check_Bad_Body (Main_Unit_Node, Main_Unit_Kind);
+--  In CodePeer mode we always delete old SCIL files before regenerating
+--  new ones, in case of e.g. errors, and also to remove obsolete scilx
+--  files generated by CodePeer itself.
+if CodePeer_Mode then
+Comperr.Delete_SCIL_Files;
+end if;
+--  Ditto for old C files before regenerating new ones
+if Generate_C_Code then
+Delete_C_File;
+Delete_H_File;
+end if;
+--  Exit if compilation errors detected
+Errout.Finalize (Last_Call => False);
+if Compilation_Errors then
+Treepr.Tree_Dump;
+Post_Compilation_Validation_Checks;
+Errout.Output_Messages;
+Namet.Finalize;
+--  Generate ALI file if specially requested
+if Opt.Force_ALI_Tree_File then
+Write_ALI (Object => False);
+Tree_Gen;
+end if;
+Errout.Finalize (Last_Call => True);
+Exit_Program (E_Errors);
+end if;
+--  Set Generate_Code on main unit and its spec. We do this even if are
+--  not generating code, since Lib-Writ uses this to determine which
+--  units get written in the ali file.
+Set_Generate_Code (Main_Unit);
+--  If we have a corresponding spec, and it comes from source or it is
+--  not a generated spec for a child subprogram body, then we need object
+--  code for the spec unit as well.
+if Nkind (Unit (Main_Unit_Node)) in N_Unit_Body
+and then not Acts_As_Spec (Main_Unit_Node)
+then
+if Nkind (Unit (Main_Unit_Node)) = N_Subprogram_Body
+and then not Comes_From_Source (Library_Unit (Main_Unit_Node))
+then
+null;
+else
+Set_Generate_Code
+(Get_Cunit_Unit_Number (Library_Unit (Main_Unit_Node)));
+end if;
+end if;
+--  Case of no code required to be generated, exit indicating no error
+if Original_Operating_Mode = Check_Syntax then
+Treepr.Tree_Dump;
+Errout.Finalize (Last_Call => True);
+Errout.Output_Messages;
+Tree_Gen;
+Namet.Finalize;
+Check_Rep_Info;
+--  Use a goto instead of calling Exit_Program so that finalization
+--  occurs normally.
+goto End_Of_Program;
+elsif Original_Operating_Mode = Check_Semantics then
+Back_End_Mode := Declarations_Only;
+--  All remaining cases are cases in which the user requested that code
+--  be generated (i.e. no -gnatc or -gnats switch was used). Check if we
+--  can in fact satisfy this request.
+--  Cannot generate code if someone has turned off code generation for
+--  any reason at all. We will try to figure out a reason below.
+elsif Operating_Mode /= Generate_Code then
+Back_End_Mode := Skip;
+--  We can generate code for a subprogram body unless there were missing
+--  subunits. Note that we always generate code for all generic units (a
+--  change from some previous versions of GNAT).
+elsif Main_Unit_Kind = N_Subprogram_Body
+and then not Subunits_Missing
+then
+Back_End_Mode := Generate_Object;
+--  We can generate code for a package body unless there are subunits
+--  missing (note that we always generate code for generic units, which
+--  is a change from some earlier versions of GNAT).
+elsif Main_Unit_Kind = N_Package_Body and then not Subunits_Missing then
+Back_End_Mode := Generate_Object;
+--  We can generate code for a package declaration or a subprogram
+--  declaration only if it does not required a body.
+elsif Nkind_In (Main_Unit_Kind, N_Package_Declaration,
+N_Subprogram_Declaration)
+and then
+(not Body_Required (Main_Unit_Node)
+or else Distribution_Stub_Mode = Generate_Caller_Stub_Body)
+then
+Back_End_Mode := Generate_Object;
+--  We can generate code for a generic package declaration of a generic
+--  subprogram declaration only if does not require a body.
+elsif Nkind_In (Main_Unit_Kind, N_Generic_Package_Declaration,
+N_Generic_Subprogram_Declaration)
+and then not Body_Required (Main_Unit_Node)
+then
+Back_End_Mode := Generate_Object;
+--  Compilation units that are renamings do not require bodies, so we can
+--  generate code for them.
+elsif Nkind_In (Main_Unit_Kind, N_Package_Renaming_Declaration,
+N_Subprogram_Renaming_Declaration)
+then
+Back_End_Mode := Generate_Object;
+--  Compilation units that are generic renamings do not require bodies
+--  so we can generate code for them.
+elsif Main_Unit_Kind in N_Generic_Renaming_Declaration then
+Back_End_Mode := Generate_Object;
+--  It is not an error to analyze in CodePeer mode a spec which requires
+--  a body, in order to generate SCIL for this spec.
+--  Ditto for Generate_C_Code mode and generate a C header for a spec.
+elsif CodePeer_Mode or Generate_C_Code then
+Back_End_Mode := Generate_Object;
+--  It is not an error to analyze in GNATprove mode a spec which requires
+--  a body, when the body is not available. During frame condition
+--  generation, the corresponding ALI file is generated. During
+--  analysis, the spec is analyzed.
+elsif GNATprove_Mode then
+Back_End_Mode := Declarations_Only;
+--  In all other cases (specs which have bodies, generics, and bodies
+--  where subunits are missing), we cannot generate code and we generate
+--  a warning message. Note that generic instantiations are gone at this
+--  stage since they have been replaced by their instances.
+else
+Back_End_Mode := Skip;
+end if;
+--  At this stage Back_End_Mode is set to indicate if the backend should
+--  be called to generate code. If it is Skip, then code generation has
+--  been turned off, even though code was requested by the original
+--  command. This is not an error from the user point of view, but it is
+--  an error from the point of view of the gcc driver, so we must exit
+--  with an error status.
+--  We generate an informative message (from the gcc point of view, it
+--  is an error message, but from the users point of view this is not an
+--  error, just a consequence of compiling something that cannot
+--  generate code).
+if Back_End_Mode = Skip then
+--  An ignored Ghost unit is rewritten into a null statement because
+--  it must not produce an ALI or object file. Do not emit any errors
+--  related to code generation because the unit does not exist.
+if Is_Ignored_Ghost_Unit (Main_Unit_Node) then
+--  Exit the gnat driver with success, otherwise external builders
+--  such as gnatmake and gprbuild will treat the compilation of an
+--  ignored Ghost unit as a failure. Note that this will produce
+--  an empty object file for the unit.
+Ecode := E_Success;
+--  Otherwise the unit is missing a crucial piece that prevents code
+--  generation.
+else
+Ecode := E_No_Code;
+Set_Standard_Error;
+Write_Str ("cannot generate code for file ");
+Write_Name (Unit_File_Name (Main_Unit));
+if Subunits_Missing then
+Write_Str (" (missing subunits)");
+Write_Eol;
+--  Force generation of ALI file, for backward compatibility
+Opt.Force_ALI_Tree_File := True;
+elsif Main_Unit_Kind = N_Subunit then
+Write_Str (" (subunit)");
+Write_Eol;
+--  Do not generate an ALI file in this case, because it would
+--  become obsolete when the parent is compiled, and thus
+--  confuse tools such as gnatfind.
+elsif Main_Unit_Kind = N_Subprogram_Declaration then
+Write_Str (" (subprogram spec)");
+Write_Eol;
+--  Generic package body in GNAT implementation mode
+elsif Main_Unit_Kind = N_Package_Body and then GNAT_Mode then
+Write_Str (" (predefined generic)");
+Write_Eol;
+--  Force generation of ALI file, for backward compatibility
+Opt.Force_ALI_Tree_File := True;
+--  Only other case is a package spec
+else
+Write_Str (" (package spec)");
+Write_Eol;
+end if;
+end if;
+Set_Standard_Output;
+Post_Compilation_Validation_Checks;
+Errout.Finalize (Last_Call => True);
+Errout.Output_Messages;
+Treepr.Tree_Dump;
+Tree_Gen;
+--  Generate ALI file if specially requested, or for missing subunits,
+--  subunits or predefined generic.
+if Opt.Force_ALI_Tree_File then
+Write_ALI (Object => False);
+end if;
+Namet.Finalize;
+Check_Rep_Info;
+--  Exit the driver with an appropriate status indicator. This will
+--  generate an empty object file for ignored Ghost units, otherwise
+--  no object file will be generated.
+Exit_Program (Ecode);
+end if;
+--  In -gnatc mode, we only do annotation if -gnatt or -gnatR is also set
+--  as indicated by Back_Annotate_Rep_Info being set to True.
+--  We don't call for annotations on a subunit, because to process those
+--  the back end requires that the parent(s) be properly compiled.
+--  Annotation is suppressed for targets where front-end layout is
+--  enabled, because the front end determines representations.
+--  The back end is not invoked in ASIS mode with GNSA because all type
+--  representation information will be provided by the GNSA back end, not
+--  gigi.
+if Back_End_Mode = Declarations_Only
+and then
+(not (Back_Annotate_Rep_Info or Generate_SCIL or GNATprove_Mode)
+or else Main_Unit_Kind = N_Subunit
+or else ASIS_GNSA_Mode)
+then
+Post_Compilation_Validation_Checks;
+Errout.Finalize (Last_Call => True);
+Errout.Output_Messages;
+Write_ALI (Object => False);
+Tree_Dump;
+Tree_Gen;
+Namet.Finalize;
+Check_Rep_Info;
+return;
+end if;
+--  Ensure that we properly register a dependency on system.ads, since
+--  even if we do not semantically depend on this, Targparm has read
+--  system parameters from the system.ads file.
+Lib.Writ.Ensure_System_Dependency;
+--  Add dependencies, if any, on preprocessing data file and on
+--  preprocessing definition file(s).
+Prepcomp.Add_Dependencies;
+if GNATprove_Mode then
+--  Perform the new SPARK checking rules for pointer aliasing. This is
+--  only activated in GNATprove mode and on SPARK code.
+if Debug_Flag_FF then
+Check_Safe_Pointers (Main_Unit_Node);
+end if;
+--  In GNATprove mode we're writing the ALI much earlier than usual
+--  as flow analysis needs the file present in order to append its
+--  own globals to it.
+--  Note: In GNATprove mode, an "object" file is always generated as
+--  the result of calling gnat1 or gnat2why, although this is not the
+--  same as the object file produced for compilation.
+Write_ALI (Object => True);
+end if;
+--  Some back ends (for instance Gigi) are known to rely on SCOs for code
+--  generation. Make sure they are available.
+if Generate_SCO then
+Par_SCO.SCO_Record_Filtered;
+end if;
+--  Back end needs to explicitly unlock tables it needs to touch
+Atree.Lock;
+Elists.Lock;
+Fname.UF.Lock;
+Ghost.Lock;
+Inline.Lock;
+Lib.Lock;
+Namet.Lock;
+Nlists.Lock;
+Sem.Lock;
+Sinput.Lock;
+Stringt.Lock;
+--  Here we call the back end to generate the output code
+Generating_Code := True;
+Back_End.Call_Back_End (Back_End_Mode);
+--  Once the backend is complete, we unlock the names table. This call
+--  allows a few extra entries, needed for example for the file name
+--  for the library file output.
+Namet.Unlock;
+--  Generate the call-graph output of dispatching calls
+Exp_CG.Generate_CG_Output;
+--  Perform post compilation validation checks
+Post_Compilation_Validation_Checks;
+--  Now we complete output of errors, rep info and the tree info. These
+--  are delayed till now, since it is perfectly possible for gigi to
+--  generate errors, modify the tree (in particular by setting flags
+--  indicating that elaboration is required, and also to back annotate
+--  representation information for List_Rep_Info).
+Errout.Finalize (Last_Call => True);
+Errout.Output_Messages;
+List_Rep_Info (Ttypes.Bytes_Big_Endian);
+Inline.List_Inlining_Info;
+--  Only write the library if the backend did not generate any error
+--  messages. Otherwise signal errors to the driver program so that
+--  there will be no attempt to generate an object file.
+if Compilation_Errors then
+Treepr.Tree_Dump;
+Exit_Program (E_Errors);
+end if;
+if not GNATprove_Mode then
+Write_ALI (Object => (Back_End_Mode = Generate_Object));
+end if;
+if not Compilation_Errors then
+--  In case of ada backends, we need to make sure that the generated
+--  object file has a timestamp greater than the ALI file. We do this
+--  to make gnatmake happy when checking the ALI and obj timestamps,
+--  where it expects the object file being written after the ali file.
+--  Gnatmake's assumption is true for gcc platforms where the gcc
+--  wrapper needs to call the assembler after calling gnat1, but is
+--  not true for ada backends, where the object files are created
+--  directly by gnat1 (so are created before the ali file).
+Back_End.Gen_Or_Update_Object_File;
+end if;
+--  Generate ASIS tree after writing the ALI file, since in ASIS mode,
+--  Write_ALI may in fact result in further tree decoration from the
+--  original tree file. Note that we dump the tree just before generating
+--  it, so that the dump will exactly reflect what is written out.
+Treepr.Tree_Dump;
+Tree_Gen;
+--  Finalize name table and we are all done
+Namet.Finalize;
+exception
+--  Handle fatal internal compiler errors
+when Rtsfind.RE_Not_Available =>
+Comperr.Compiler_Abort ("RE_Not_Available");
+when System.Assertions.Assert_Failure =>
+Comperr.Compiler_Abort ("Assert_Failure");
+when Constraint_Error =>
+Comperr.Compiler_Abort ("Constraint_Error");
+when Program_Error =>
+Comperr.Compiler_Abort ("Program_Error");
+--  Assume this is a bug. If it is real, the message will in any case
+--  say Storage_Error, giving a strong hint.
+when Storage_Error =>
+Comperr.Compiler_Abort ("Storage_Error");
+when Unrecoverable_Error =>
+raise;
+when others =>
+Comperr.Compiler_Abort ("exception");
+end;
+<<End_Of_Program>>
+null;
+--  The outer exception handler handles an unrecoverable error
+exception
+when Unrecoverable_Error =>
+Errout.Finalize (Last_Call => True);
+Errout.Output_Messages;
+Set_Standard_Error;
+Write_Str ("compilation abandoned");
+Write_Eol;
+Set_Standard_Output;
+Source_Dump;
+Tree_Dump;
+Exit_Program (E_Errors);
+end Gnat1drv;

Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/gnat1drv.adb @ 111:04ced10e8804