ghdllocal.adb

vhdl集成电路设计软件.需要用gcc-4.0.2版本编译.

--  GHDL driver - local commands.
--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
--
--  GHDL is free software; you can redistribute it and/or modify it under
--  the terms of the GNU General Public License as published by the Free
--  Software Foundation; either version 2, or (at your option) any later
--  version.
--
--  GHDL is distributed in the hope that it will be useful, but WITHOUT 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
--  along with GCC; see the file COPYING.  If not, write to the Free
--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
--  02111-1307, USA.
with Ada.Text_IO;
with Ghdlmain;
with Types; use Types;
with Libraries;
with Std_Package;
with Flags;
with Name_Table;
with Std_Names;
with Back_End;
with Disp_Vhdl;
with Default_Pathes;
with Scan;
with Sem;
with Canon;
with Errorout;
with Configuration;
with Files_Map;
with Post_Sems;
with Disp_Tree;

package body Ghdllocal is
   --  Version of the IEEE library to use.  This just change pathes.
   type Ieee_Lib_Kind is (Lib_Standard, Lib_None, Lib_Synopsys, Lib_Mentor);
   Flag_Ieee : Ieee_Lib_Kind;

   Flag_Create_Default_Config : Boolean := True;

   procedure Finish_Compilation
     (Unit : Iir_Design_Unit; Main : Boolean := False)
   is
      use Errorout;
      use Ada.Text_IO;
      Config : Iir_Design_Unit;
      Lib : Iir;
   begin
      if Flags.Verbose then
         Put_Line ("semantize " & Disp_Node (Get_Library_Unit (Unit)));
      end if;

      Sem.Semantic (Unit);

      if (Main or Flags.Dump_All) and then Flags.Dump_Sem then
         Disp_Tree.Disp_Tree (Unit);
      end if;

      if Errorout.Nbr_Errors > 0 then
         raise Compilation_Error;
      end if;

      Post_Sems.Post_Sem_Checks (Unit);

      if Errorout.Nbr_Errors > 0 then
         raise Compilation_Error;
      end if;

      if Flags.Flag_Elaborate then
         if Flags.Verbose then
            Put_Line ("canonicalize " & Disp_Node (Get_Library_Unit (Unit)));
         end if;

         Canon.Canonicalize (Unit);

         if Flag_Create_Default_Config then
            Lib := Get_Library_Unit (Unit);
            if Get_Kind (Lib) = Iir_Kind_Architecture_Declaration then
               Config := Canon.Create_Default_Configuration_Declaration (Lib);
               Set_Default_Configuration_Declaration (Lib, Config);
            end if;
         end if;
      end if;
   end Finish_Compilation;

   procedure Init (Cmd : in out Command_Lib)
   is
      pragma Unreferenced (Cmd);
   begin
      Std_Names.Std_Names_Initialize;
      Libraries.Init_Pathes;
      Flag_Ieee := Lib_Standard;
      Back_End.Finish_Compilation := Finish_Compilation'Access;
      Flag_Verbose := False;
   end Init;

   procedure Decode_Option (Cmd : in out Command_Lib;
                            Option : String;
                            Arg : String;
                            Res : out Option_Res)
   is
      pragma Unreferenced (Cmd);
      pragma Unreferenced (Arg);
   begin
      Res := Option_Bad;
      if Option = "-v" and then Flag_Verbose = False then
         Flag_Verbose := True;
         Res := Option_Ok;
      elsif Option'Length > 9 and then Option (1 .. 9) = "--PREFIX=" then
         Prefix_Path := new String'(Option (10 .. Option'Last));
         Res := Option_Ok;
      elsif Option = "--ieee=synopsys" then
         Flag_Ieee := Lib_Synopsys;
         Res := Option_Ok;
      elsif Option = "--ieee=mentor" then
         Flag_Ieee := Lib_Mentor;
         Res := Option_Ok;
      elsif Option = "--ieee=none" then
         Flag_Ieee := Lib_None;
         Res := Option_Ok;
      elsif Option = "--ieee=standard" then
         Flag_Ieee := Lib_Standard;
         Res := Option_Ok;
      elsif Option'Length >= 2
        and then (Option (2) = 'g' or Option (2) = 'O')
      then
         --  Silently accept -g and -O.
         Res := Option_Ok;
      else
         if Flags.Parse_Option (Option) then
            Res := Option_Ok;
         end if;
      end if;
   end Decode_Option;

   procedure Disp_Long_Help (Cmd : Command_Lib)
   is
      pragma Unreferenced (Cmd);
      use Ada.Text_IO;
      procedure P (Str : String) renames Put_Line;
   begin
      P ("Options:");
      P (" --std=XX       Use XX as VHDL standard (87,93c,93,00 or 02)");
      P (" --work=NAME    Set the name of the WORK library");
      P (" -PDIR          Add DIR in the library search path");
      P (" --workdir=DIR  Specify the directory of the WORK library");
      P (" --PREFIX=DIR   Specify installation prefix");

      P (" --ieee=NAME    Use NAME as ieee library, where name is:");
      P ("    standard: standard version (default)");
      P ("    synopsys, mentor: vendor version (bad)");
      P ("    none: do not use a predefined ieee library");
   end Disp_Long_Help;

   function Get_Version_Path return String is
   begin
      case Flags.Vhdl_Std is
         when Vhdl_87 =>
            return "v87";
         when Vhdl_93c
           | Vhdl_93
           | Vhdl_00
           | Vhdl_02 =>
            return "v93";
      end case;
   end Get_Version_Path;

   procedure Add_Library_Path (Name : String)
   is
   begin
      Libraries.Add_Library_Path
        (Prefix_Path.all & Get_Version_Path & Directory_Separator
         & Name & Directory_Separator);
   end Add_Library_Path;

   procedure Setup_Libraries (Load : Boolean)
   is
   begin
      if Prefix_Path = null then
         Prefix_Path := new String'(Default_Pathes.Prefix);
      end if;

      --  Add pathes for predefined libraries.
      if not Flags.Bootstrap then
         Add_Library_Path ("std");
         case Flag_Ieee is
            when Lib_Standard =>
               Add_Library_Path ("ieee");
            when Lib_Synopsys =>
               Add_Library_Path ("synopsys");
            when Lib_Mentor =>
               Add_Library_Path ("mentor");
            when Lib_None =>
               null;
         end case;
      end if;
      if Load then
         Libraries.Load_Std_Library;
         Libraries.Load_Work_Library;
      end if;
   end Setup_Libraries;

   procedure Disp_Library_Unit (Unit : Iir)
   is
      use Ada.Text_IO;
      use Name_Table;
      Id : Name_Id;
   begin
      Id := Get_Identifier (Unit);
      case Get_Kind (Unit) is
         when Iir_Kind_Entity_Declaration =>
            Put ("entity ");
         when Iir_Kind_Architecture_Declaration =>
            Put ("architecture ");
         when Iir_Kind_Configuration_Declaration =>
            Put ("configuration ");
         when Iir_Kind_Package_Declaration =>
            Put ("package ");
         when Iir_Kind_Package_Body =>
            Put ("package body ");
         when others =>
            Put ("???");
            return;
      end case;
      Image (Id);
      Put (Name_Buffer (1 .. Name_Length));
      case Get_Kind (Unit) is
         when Iir_Kind_Architecture_Declaration =>
            Put (" of ");
            Image (Get_Identifier (Get_Entity (Unit)));
            Put (Name_Buffer (1 .. Name_Length));
         when Iir_Kind_Configuration_Declaration =>
            if Id = Null_Identifier then
               Put ("<default> of entity ");
               Image (Get_Identifier (Get_Library_Unit (Get_Entity (Unit))));
               Put (Name_Buffer (1 .. Name_Length));
            end if;
         when others =>
            null;
      end case;
   end Disp_Library_Unit;

   procedure Disp_Library (Name : Name_Id)
   is
      use Ada.Text_IO;
      use Libraries;
      Lib : Iir_Library_Declaration;
      File : Iir_Design_File;
      Unit : Iir;
   begin
      if Name = Std_Names.Name_Work then
         Lib := Work_Library;
      elsif Name = Std_Names.Name_Std then
         Lib := Std_Library;
      else
         Lib := Get_Library (Name, Command_Line_Location);
      end if;

      --  Disp contents of files.
      File := Get_Design_File_Chain (Lib);
      while File /= Null_Iir loop
         Unit := Get_First_Design_Unit (File);
         while Unit /= Null_Iir loop
            Disp_Library_Unit (Get_Library_Unit (Unit));
            New_Line;
            Unit := Get_Chain (Unit);
         end loop;
         File := Get_Chain (File);
      end loop;
   end Disp_Library;

   --  Return FILENAME without the extension.
   function Get_Base_Name (Filename : String; Remove_Dir : Boolean := True)
                           return String
   is
      First : Natural;
      Last : Natural;
   begin
      First := Filename'First;
      Last := Filename'Last;
      for I in Filename'Range loop
         if Filename (I) = '.' then
            Last := I - 1;
         elsif Remove_Dir and then Filename (I) = Directory_Separator then
            First := I + 1;
            Last := Filename'Last;
         end if;
      end loop;
      return Filename (First .. Last);
   end Get_Base_Name;

   function Append_Suffix (File : String; Suffix : String) return String_Access
   is
      use Name_Table;
      Basename : String := Get_Base_Name (File);
   begin
      Image (Libraries.Work_Directory);
      Name_Buffer (Name_Length + 1 .. Name_Length + Basename'Length) :=
        Basename;
      Name_Length := Name_Length + Basename'Length;
      Name_Buffer (Name_Length + 1 .. Name_Length + Suffix'Length) := Suffix;
      Name_Length := Name_Length + Suffix'Length;
      return new String'(Name_Buffer (1 .. Name_Length));
   end Append_Suffix;


   --  Command Dir.
   type Command_Dir is new Command_Lib with null record;
   function Decode_Command (Cmd : Command_Dir; Name : String) return Boolean;
   function Get_Short_Help (Cmd : Command_Dir) return String;
   procedure Perform_Action (Cmd : in out Command_Dir; Args : Argument_List);

   function Decode_Command (Cmd : Command_Dir; Name : String) return Boolean
   is
      pragma Unreferenced (Cmd);
   begin
      return Name = "-d" or else Name = "--dir";
   end Decode_Command;

   function Get_Short_Help (Cmd : Command_Dir) return String
   is
      pragma Unreferenced (Cmd);
   begin
      return "-d or --dir        Disp contents of the work library";
   end Get_Short_Help;

   procedure Perform_Action (Cmd : in out Command_Dir; Args : Argument_List)
   is
      pragma Unreferenced (Cmd);
   begin
      if Args'Length /= 0 then
         Error ("command '-d' does not accept any argument");
         raise Option_Error;
      end if;

      Flags.Bootstrap := True;
      --  Load word library.
      Libraries.Load_Std_Library;
      Libraries.Load_Work_Library;

      Disp_Library (Std_Names.Name_Work);

--       else
--          for L in Libs'Range loop
--             Id := Get_Identifier (Libs (L).all);
--             Disp_Library (Id);
--          end loop;