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 / gnatfdrv.adb < prev    next >
Text File  |  1996-09-28  |  6KB  |  190 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT COMPILER COMPONENTS                         --
  4. --                                                                          --
  5. --                             G N A T F D R V                              --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.35 $                             --
  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 Csets;    use Csets;
  26. with Comperr;
  27. with Errout;   use Errout;
  28. with Features;
  29. with Frontend;
  30. with Gnatvsn;
  31. with Lib;
  32. with Namet;    use Namet;
  33. with Opt;      use Opt;
  34. with Osint;    use Osint;
  35. with Output;   use Output;
  36. with Par;
  37. with Sem_Type;
  38. with Snames;
  39. with Sprint;
  40. with Stringt;
  41. with System.Assertions;
  42. with Treepr;
  43. with Types;    use Types;
  44. with Uintp;
  45. with Urealp;
  46. with Usage;
  47. with Xref;
  48.  
  49. procedure Gnatfdrv is
  50.  
  51.    Total_Warnings : Nat := 0;
  52.    --  Counts total warnings in all files
  53.  
  54.    Total_Errors : Nat := 0;
  55.    --  Counts total errors in all files
  56.  
  57. begin
  58.    --  The following package initializations are done once for the complete
  59.    --  set of main source files. It is in particular important that the
  60.    --  names table not be reinitialized between compilations, since we use
  61.    --  name table indexes in the source file table.
  62.  
  63.    Osint.Initialize (Compiler);
  64.    Xref.Initialize;
  65.    Csets.Initialize;
  66.    Uintp.Initialize;
  67.    Urealp.Initialize;
  68.    Namet.Initialize;
  69.    Snames.Initialize;
  70.    Stringt.Initialize;
  71.    Features.Initialize;
  72.    Errout.Initialize;
  73.  
  74.    if Verbose_Mode or Full_List then
  75.       Write_Eol;
  76.       Write_Eol;
  77.       Write_Str ("GNAT Front End/XREF Tool Version ");
  78.       Write_Str (Gnatvsn.Gnat_Version_String);
  79.       Write_Str (" (C) Copyright NYU, 1992,1993,1994");
  80.       Write_Eol;
  81.    end if;
  82.  
  83.    --  Output usage information if no files
  84.  
  85.    if not More_Source_Files then
  86.       Usage;
  87.       Exit_Program (E_Fatal);
  88.    end if;
  89.  
  90.    --  Either we are in syntax only mode (when calling gnatchop) or
  91.    --  we want to perform semantic checks for Xref.
  92.  
  93.    if Operating_Mode = Generate_Code then
  94.       Operating_Mode := Check_Semantics;
  95.    end if;
  96.  
  97.    --  Loop through files
  98.  
  99.    while More_Source_Files loop
  100.  
  101.       --  The outer block is here to handle an unrecoverable error if one
  102.       --  is signalled (by raising the Unrecoverable_Error exception).
  103.  
  104.       begin
  105.          --  The inner block is here to handle an assert error or constraint
  106.          --  error. We need the nested blocks because the handling of these
  107.          --  exceptions can end up raising an Unrecoverable_Error exception.
  108.  
  109.          begin
  110.             Frontend;
  111.  
  112.             --  Update total error counts
  113.  
  114.             Total_Warnings := Total_Warnings + Warnings_Detected;
  115.             Total_Errors   := Total_Errors + Errors_Detected;
  116.  
  117.             --  Let the Xref gather what it needs if there are no errors. We
  118.             --  do not attempt to gather cross-reference info if errors occur.
  119.  
  120.             exit when Total_Errors > 0;
  121.             Xref.Gather_Xref_Info (Lib.Cunit (Main_Unit));
  122.  
  123.             --  We don't reinitialize the names table for each file, since, as
  124.             --  noted above, name table indices are used in the source file
  125.             --  table and must not change from one compilation to another.
  126.             --  However, it is necessary to reset the associated entity
  127.             --  information, since that gets invalidated by destroying the
  128.             --  tree for each new file.
  129.  
  130.             Namet.Reset_Name_Table;
  131.             Sem_Type.Init_Interp_Tables;
  132.  
  133.          --  Exception handler catches fatal internal errors
  134.  
  135.          exception
  136.  
  137.             when System.Assertions.Assert_Failure =>
  138.                Comperr.Compiler_Abort ("Assert_Failure");
  139.  
  140.             when Constraint_Error =>
  141.                Comperr.Compiler_Abort ("Constraint_Error");
  142.  
  143.             when Program_Error =>
  144.                Comperr.Compiler_Abort ("Program_Error");
  145.  
  146.             when Storage_Error =>
  147.                Set_Standard_Error;
  148.                Write_Str ("insufficient memory for compiler");
  149.                Write_Eol;
  150.                raise Unrecoverable_Error;
  151.          end;
  152.  
  153.       --  This is the handler for the outer block
  154.  
  155.       exception
  156.          when Unrecoverable_Error =>
  157.             Total_Warnings := Total_Warnings + Warnings_Detected;
  158.             Total_Errors := Total_Errors + Errors_Detected;
  159.             Errout.Finalize;
  160.             Set_Standard_Error;
  161.             Write_Str ("compilation of ");
  162.             Write_Name (Lib.Unit_File_Name (Main_Unit));
  163.             Write_Str (" abandoned");
  164.             Write_Eol;
  165.             Set_Standard_Output;
  166.             Treepr.Tree_Dump;
  167.             Sprint.Source_Dump;
  168.             Exit_Program (E_Errors);
  169.       end;
  170.  
  171.    end loop;
  172.  
  173.    if Total_Errors = 0 then
  174.       Xref.Finalize;
  175.    end if;
  176.  
  177.    Errout.Finalize;
  178.    Features.Finalize;
  179.    Namet.Finalize;
  180.  
  181.    --  All done. Set proper exit status
  182.  
  183.    if Total_Errors > 0 then
  184.       Exit_Program (E_Errors);
  185.    else
  186.       Exit_Program (E_Success);
  187.    end if;
  188.  
  189. end Gnatfdrv;
  190.