home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / gnat-2.06-src.tgz / tar.out / fsf / gnat / ada / gnat1drv.adb < prev    next >
Text File  |  1996-09-28  |  9KB  |  252 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT COMPILER COMPONENTS                         --
  4. --                                                                          --
  5. --                             G N A T 1 D R V                              --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.40 $                             --
  10. --                                                                          --
  11. --        Copyright (c) 1992,1993,1994,1995 NYU, All Rights Reserved        --
  12. --                                                                          --
  13. -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14. -- terms of the  GNU General Public License as published  by the Free Soft- --
  15. -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16. -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17. -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18. -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19. -- for  more details.  You should have  received  a copy of the GNU General --
  20. -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21. -- to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. --
  22. --                                                                          --
  23. ------------------------------------------------------------------------------
  24.  
  25. with Atree;    use Atree;
  26. with Comperr;
  27. with Csets;    use Csets;
  28. with Back_End;
  29. with Errout;   use Errout;
  30. with Features;
  31. with Frontend;
  32. with Gnatvsn;  use Gnatvsn;
  33. with Lib;      use Lib;
  34. with Lib.Writ; use Lib.Writ;
  35. with Namet;    use Namet;
  36. with Opt;      use Opt;
  37. with Osint;    use Osint;
  38. with Output;   use Output;
  39. with Par;
  40. with Sinfo;    use Sinfo;
  41. with Snames;
  42. with Sprint;   use Sprint;
  43. with Stringt;
  44. with System.Assertions;
  45. with Tree_Gen;
  46. with Treepr;   use Treepr;
  47. with Types;    use Types;
  48. with Uintp;
  49. with Uname;    use Uname;
  50. with Urealp;
  51. with Usage;
  52.  
  53. procedure Gnat1drv is
  54.    Main_Unit_Node : Node_Id;
  55.    --  Compilation unit node for main unit
  56.  
  57.    Main_Kind : Node_Kind;
  58.    --  Kind of main compilation unit node.
  59.  
  60. begin
  61.    --  This inner block is set up to catch assertion errors and constraint
  62.    --  errors. Since the code for handling these errors can cause another
  63.    --  exception to be raised (namely Unrecoverable_Error), we need two
  64.    --  nested blocks, so that the outer one handles unrecoverable error.
  65.  
  66.    begin
  67.       Osint.Initialize (Compiler);
  68.       Csets.Initialize;
  69.       Uintp.Initialize;
  70.       Urealp.Initialize;
  71.       Errout.Initialize;
  72.       Namet.Initialize;
  73.       Snames.Initialize;
  74.       Stringt.Initialize;
  75.       Features.Initialize;
  76.  
  77.       if Verbose_Mode or Full_List then
  78.          Write_Eol;
  79.          Write_Str ("NYU GNAT Compiler Version ");
  80.          Write_Str (Gnat_Version_String);
  81.          Write_Str (" (C) Copyright NYU, 1992,1993,1994,1995");
  82.          Write_Eol;
  83.       end if;
  84.  
  85.       Frontend;
  86.  
  87.       if Errors_Detected /= 0 then
  88.          Errout.Finalize;
  89.          Exit_Program (E_Errors);
  90.       end if;
  91.  
  92.       if Operating_Mode /= Generate_Code then
  93.          Errout.Finalize;
  94.          Tree_Gen;
  95.          Namet.Finalize;
  96.          Features.Finalize;
  97.          return;
  98.       end if;
  99.  
  100.       --  Check for unit that generates no code, and if so, generate
  101.       --  warning message and suppress expander and code generation.
  102.  
  103.       Main_Unit_Node := Cunit (Main_Unit);
  104.       Main_Kind := Nkind (Unit (Main_Unit_Node));
  105.  
  106.       --  Generate code for subprogram bodies only if they have
  107.       --  a corresponding non-generic subprogram declaration. Note
  108.       --  that the check for No (Library_Unit) here is a defensive
  109.       --  check that should not be necessary, since the Library_Unit
  110.       --  field should always be set properly.
  111.  
  112.       if Main_Kind = N_Subprogram_Body
  113.         and then (No (Library_Unit (Main_Unit_Node))
  114.                    or else Nkind (Unit (Library_Unit (Main_Unit_Node))) /=
  115.                                           N_Generic_Subprogram_Declaration)
  116.       then
  117.          null;
  118.  
  119.       --  Generate code for package bodies only if they have
  120.       --  a corresponding non-generic package declaration
  121.  
  122.       elsif Main_Kind = N_Package_Body
  123.         and then (No (Library_Unit (Main_Unit_Node))
  124.            or else Nkind (Unit (Library_Unit (Main_Unit_Node))) /=
  125.                       N_Generic_Package_Declaration)
  126.       then
  127.          null;
  128.  
  129.       --  Generate code for package declarations that do not
  130.       --  require a corresponding body
  131.  
  132.       elsif Main_Kind = N_Package_Declaration
  133.         and then not Body_Required (Main_Unit_Node)
  134.       then
  135.          null;
  136.  
  137.       --  Compilation units that are renamings do not require
  138.       --  bodies either.
  139.  
  140.       elsif Main_Kind = N_Package_Renaming_Declaration
  141.         or else Main_Kind = N_Subprogram_Renaming_Declaration
  142.       then
  143.          null;
  144.  
  145.       --  In all other cases (specs which have bodies, and generics)
  146.       --  we cannot generate code and we generate a warning message.
  147.       --  Note that generic instantiations are gone at this stage
  148.       --  since they have been replaced by their instances.
  149.  
  150.       --  Also note that we exit with an error, to prevent the backend
  151.       --  from generating an object module, which is wrong, and more
  152.       --  significantly, might cause a legitimate object module for the
  153.       --  corresponding body to be clobbered.
  154.  
  155.       else
  156.          Write_Str ("No code generated for ");
  157.          Write_Unit_Name (Unit_Name (Main_Unit));
  158.          Write_Str (" in file ");
  159.          Write_Name (Unit_File_Name (Main_Unit));
  160.          Write_Eol;
  161.          Errout.Finalize;
  162.          Tree_Gen;
  163.          Namet.Finalize;
  164.  
  165.          --  In case a generic unit is being compiled exit with a Success exit
  166.          --  code in preparation of compiling generic units. This is code
  167.          --  which will disappear when we *do* compile generic units. ???
  168.  
  169.          if Main_Kind = N_Subprogram_Body
  170.            and then Present (Library_Unit (Main_Unit_Node))
  171.            and then Nkind (Unit (Library_Unit (Main_Unit_Node))) =
  172.                                            N_Generic_Subprogram_Declaration
  173.          then
  174.             Exit_Program (E_Success);
  175.  
  176.          elsif Main_Kind = N_Package_Body
  177.            and then Present (Library_Unit (Main_Unit_Node))
  178.            and then Nkind (Unit (Library_Unit (Main_Unit_Node))) =
  179.                                            N_Generic_Package_Declaration
  180.          then
  181.             Exit_Program (E_Success);
  182.  
  183.          else
  184.             Exit_Program (E_Errors);
  185.          end if;
  186.       end if;
  187.  
  188.       Set_Generate_Code (Main_Unit);
  189.  
  190.       --  If we have a corresponding spec, then we need object
  191.       --  code for the spec unit as well
  192.  
  193.       if Nkind (Unit (Main_Unit_Node)) in N_Unit_Body
  194.         and then not Acts_As_Spec (Main_Unit_Node)
  195.       then
  196.          Set_Generate_Code
  197.            (Get_Cunit_Unit_Number (Library_Unit (Main_Unit_Node)));
  198.       end if;
  199.  
  200.       --  Generate back end tables and library information
  201.  
  202.       Back_End;
  203.       Errout.Finalize;
  204.       Tree_Gen;
  205.       Features.Finalize;
  206.  
  207.       --  Only write the library if the backend did not generate any error
  208.       --  messages. Otherwise signal errors to the driver program so that
  209.       --  there will be no attempt to generate an object file.
  210.  
  211.       if Errors_Detected /= 0 then
  212.          Exit_Program (E_Errors);
  213.       end if;
  214.  
  215.       Lib.Writ.Write_Library_Info;
  216.       Namet.Finalize;
  217.  
  218.    exception
  219.       --  Handle fatal internal compiler errors
  220.  
  221.       when System.Assertions.Assert_Failure =>
  222.          Comperr.Compiler_Abort ("Assert_Failure");
  223.  
  224.       when Constraint_Error =>
  225.          Comperr.Compiler_Abort ("Constraint_Error");
  226.  
  227.       when Program_Error =>
  228.          Comperr.Compiler_Abort ("Program_Error");
  229.  
  230.       when Storage_Error =>
  231.          Set_Standard_Error;
  232.          Write_Str ("insufficient memory for compiler");
  233.          Write_Eol;
  234.          raise Unrecoverable_Error;
  235.    end;
  236.  
  237. --  The outer exception handles an unrecoverable error
  238.  
  239. exception
  240.    when Unrecoverable_Error =>
  241.       Errout.Finalize;
  242.       Set_Standard_Error;
  243.       Write_Str ("compilation abandoned");
  244.       Write_Eol;
  245.       Set_Standard_Output;
  246.  
  247.       Tree_Dump;
  248.       Source_Dump;
  249.       Exit_Program (E_Errors);
  250.  
  251. end Gnat1drv;
  252.