Subversion Repositories openrisc

------------------------------------------------------------------------------

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                             G N A T 1 D R V                              --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          Copyright (C) 1992-2009, 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 Comperr;

with Csets;    use Csets;

with Debug;    use Debug;

with Elists;

with Errout;   use Errout;

with Fmap;

with Fname;    use Fname;

with Fname.UF; use Fname.UF;

with Frontend;

with Gnatvsn;  use Gnatvsn;

with Hostparm;

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 Output;   use Output;

with Par_SCO;

with Prepcomp;

with Repinfo;  use Repinfo;

with Restrict;

with Rtsfind;

with SCOs;

with Sem;

with Sem_Ch8;

with Sem_Ch12;

with Sem_Ch13;

with Sem_Elim;

with Sem_Eval;

with Sem_Type;

with Sinfo;    use Sinfo;

with Sinput.L; use Sinput.L;

with Snames;

with Sprint;   use Sprint;

with Stringt;

with Stylesw;  use Stylesw;

with Targparm; use Targparm;

with Tree_Gen;

with Treepr;   use Treepr;

with Ttypes;

with Types;    use Types;

with Uintp;    use Uintp;

with Uname;    use Uname;

with Urealp;

with Usage;

with Validsw;  use Validsw;

with System.Assertions;

procedure Gnat1drv is

   Main_Unit_Node : Node_Id;

   --  Compilation unit node for main unit

   Main_Kind : Node_Kind;

   --  Kind of main compilation unit node

   Back_End_Mode : Back_End.Back_End_Mode_Type;

   --  Record back end mode

   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;

   --  Called to check if the unit we are compiling 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 Check_Library_Items;

   --  For debugging -- checks the behavior of Walk_Library_Items

   pragma Warnings (Off, Check_Library_Items);

   --  In case the call below is commented out

   ----------------------------

   -- Adjust_Global_Switches --

   ----------------------------

   procedure Adjust_Global_Switches is

   begin

      --  Debug flag -gnatd.I is a synonym for Generate_SCIL and requires code

      --  generation.

      if Debug_Flag_Dot_II

        and then Operating_Mode = Generate_Code

      then

         Generate_SCIL := True;

      end if;

      --  Set ASIS mode if -gnatt and -gnatc are set

      if Operating_Mode = Check_Semantics and then Tree_Output then

         ASIS_Mode := True;

         --  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 in ASIS mode, since SCIL requires front-

         --  end expansion.

         Generate_SCIL := 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 inlining, confuses CodePeer output and gains nothing

         Front_End_Inlining := False;

         Inline_Active      := False;

         --  Turn off ASIS mode: incompatible with front-end expansion

         ASIS_Mode := 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;

         --  Disable specific expansions for Restrictions pragmas to avoid

         --  tree inconsistencies between compilations with different pragmas

         --  that will cause different SCIL files to be generated for the

         --  same Ada spec.

         Treat_Restrictions_As_Warnings := True;

         --  Suppress overflow, division by zero and access 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 :=

           (Access_Check      => True,

            Alignment_Check   => True,

            Division_Check    => True,

            Elaboration_Check => True,

            Overflow_Check    => True,

            others            => False);

         Enable_Overflow_Checks := False;

         Dynamic_Elaboration_Checks := False;

         --  Kill debug of generated code, since it messes up sloc values

         Debug_Generated_Code := False;

         --  Turn cross-referencing on in case it was disabled (by e.g. -gnatD)

         --  Do we really need to spend time generating xref in CodePeer

         --  mode??? Consider setting Xref_Active to False.

         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 and debug pragmas, since they give CodePeer

         --  valuable extra information.

         Assertions_Enabled     := True;

         Debug_Pragmas_Enabled  := True;

         --  Suppress compiler warnings, since what we are interested in here

         --  is what CodePeer can find out. Also 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 anyway, and CodePeer understands

         --  things more clearly if references are not optimized in this way.

         Warning_Mode  := Suppress;

         Debug_Flag_MM := True;

         --  Set normal RM validity checking, and checking of IN OUT parameters

         --  (this might give CodePeer more useful checks to analyze, to be

         --  confirmed???). 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_In_Out_Params := True;

         Validity_Check_In_Params     := True;

         --  Turn off style check options since we are not interested in any

         --  front-end warnings when we are getting CodePeer output.

         Reset_Style_Check_Options;

      end if;

      --  Set Configurable_Run_Time mode if system.ads flag set

      if Targparm.Configurable_Run_Time_On_Target or Debug_Flag_YY then

         Configurable_Run_Time_Mode := True;

      end if;

      --  Set -gnatR3m 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;

      --  Disable static allocation of dispatch tables if -gnatd.t or if layout

      --  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 or else Frontend_Layout_On_Target 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;

      --  Deal with forcing OpenVMS switches True if debug flag M is set, but

      --  record the setting of Targparm.Open_VMS_On_Target in True_VMS_Target

      --  before doing this, so we know if we are in real OpenVMS or not!

      Opt.True_VMS_Target := Targparm.OpenVMS_On_Target;

      if Debug_Flag_M then

         Targparm.OpenVMS_On_Target := True;

         Hostparm.OpenVMS := True;

      end if;

      --  Activate front end layout if debug flag -gnatdF is set

      if Debug_Flag_FF then

         Targparm.Frontend_Layout_On_Target := True;

      end if;

      --  Set and check exception mechnism

      if Targparm.ZCX_By_Default_On_Target then

         if Targparm.GCC_ZCX_Support_On_Target then

            Exception_Mechanism := Back_End_Exceptions;

         else

            Osint.Fail ("Zero Cost Exceptions not supported on this target");

         end if;

      end if;

      --  Set proper status for overflow checks. We turn on overflow checks

      --  if -gnatp was not specified, and either -gnato is set or the back

      --  end takes care of overflow checks. Otherwise we suppress overflow

      --  checks by default (since front end checks are expensive).

      if not Opt.Suppress_Checks

        and then (Opt.Enable_Overflow_Checks

                    or else

                      (Targparm.Backend_Divide_Checks_On_Target

                        and

                       Targparm.Backend_Overflow_Checks_On_Target))

      then

         Suppress_Options (Overflow_Check) := False;

      else

         Suppress_Options (Overflow_Check) := True;

      end if;

   end Adjust_Global_Switches;

   --------------------

   -- Check_Bad_Body --

   --------------------

   procedure Check_Bad_Body is

      Sname   : Unit_Name_Type;

      Src_Ind : Source_File_Index;

      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, Main_Unit_Node);

         Error_Msg_File_1 := Fname;

         Error_Msg_N ("remove incorrect body in file{!", Main_Unit_Node);

      end Bad_Body_Error;

      --  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 (Main_Kind = N_Package_Declaration

           and then not Body_Required (Main_Unit_Node))

        or else (Main_Kind = N_Generic_Package_Declaration

                  and then not Body_Required (Main_Unit_Node))

        or else Main_Kind = N_Package_Renaming_Declaration

        or else Main_Kind = N_Subprogram_Renaming_Declaration

        or else Nkind (Original_Node (Unit (Main_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

         --  (but how can we have a body name here ???)

         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: if weird file names are being used, we can have

         --  situation where the file name that supposedly contains body,

         --  in fact contains a spec, or we can't tell what it contains.

         --  Skip the error message in these cases.

         --  Also ignore body that is nothing but pragma No_Body; (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 Get_Expected_Unit_Type (Fname) = Expect_Body

           and then not Source_File_Is_Subunit (Src_Ind)

           and then not Source_File_Is_No_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 Main_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?", Main_Unit_Node);

               Error_Msg_File_1 := Fname;

               Error_Msg_N ("body in file{? will be ignored", Main_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 (Main_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 Main_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 Main_Kind = N_Package_Declaration then

                     Bad_Body_Error

                       ("package $$ does not allow a body!");

                  elsif Main_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_Library_Items --

   -------------------------

   --  Walk_Library_Items has plenty of assertions, so all we need to do is

   --  call it, just for these assertions, not actually doing anything else.

   procedure Check_Library_Items is

      procedure Action (Item : Node_Id);

      --  Action passed to Walk_Library_Items to do nothing

      ------------

      -- Action --

      ------------

      procedure Action (Item : Node_Id) is

      begin

         null;

      end Action;

      procedure Walk is new Sem.Walk_Library_Items (Action);

   --  Start of processing for Check_Library_Items

   begin

      Walk;

   end Check_Library_Items;

   --------------------

   -- 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;

--  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;

      Nlists.Initialize;

      Sinput.Initialize;

      Sem.Initialize;

      Csets.Initialize;

      Uintp.Initialize;

      Urealp.Initialize;

      Errout.Initialize;

      Namet.Initialize;

      SCOs.Initialize;

      Snames.Initialize;

      Stringt.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;

      --  Acquire target parameters from system.ads (source of package System)

      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);

         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;

         --  Remember source index of system.ads (which was read successfully)

         else

            System_Source_File_Index := S;

         end if;

         Targparm.Get_Target_Parameters

           (System_Text  => Source_Text  (S),

            Source_First => Source_First (S),

            Source_Last  => Source_Last  (S));

         --  Acquire configuration pragma information from Targparm

         Restrict.Restrictions := Targparm.Restrictions_On_Target;

      end;

      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))

        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;

      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_Kind := Nkind (Unit (Main_Unit_Node));

      Check_Bad_Body;

      --  Exit if compilation errors detected

      Errout.Finalize (Last_Call => False);

      if Compilation_Errors then

         Treepr.Tree_Dump;

         Sem_Ch13.Validate_Unchecked_Conversions;

         Sem_Ch13.Validate_Address_Clauses;

         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_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_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 (Main_Kind = N_Package_Declaration

               or else

             Main_Kind = 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 (Main_Kind = N_Generic_Package_Declaration

               or else

             Main_Kind = 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 Main_Kind = N_Package_Renaming_Declaration

        or else Main_Kind = 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_Kind in N_Generic_Renaming_Declaration then

         Back_End_Mode := Generate_Object;

      --  It's not an error to generate SCIL for e.g. a spec which has a body

      elsif CodePeer_Mode then

         Back_End_Mode := Generate_Object;

      --  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

         Set_Standard_Error;

         Write_Str ("cannot generate code for ");

         Write_Str ("file ");

         Write_Name (Unit_File_Name (Main_Unit));

         if Subunits_Missing then

            Write_Str (" (missing subunits)");

            Write_Eol;