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