-- 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; use Ada.Text_IO; with Ada.Command_Line; use Ada.Command_Line; with GNAT.Directory_Operations; 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 Scanner; with Sem; with Canon; with Errorout; with Configuration; with Files_Map; with Post_Sems; with Disp_Tree; with Options; with Iirs_Utils; use Iirs_Utils; 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; -- If TRUE, generate 32bits code on 64bits machines. Flag_32bit : Boolean := False; procedure Finish_Compilation (Unit : Iir_Design_Unit; Main : Boolean := False) is use Errorout; Lib_Unit : constant Iir := Get_Library_Unit (Unit); Config : Iir_Design_Unit; begin if (Main or Flags.Dump_All) and then Flags.Dump_Parse then Disp_Tree.Disp_Tree (Unit); end if; if Flags.Verbose then Report_Msg (Msgid_Note, Semantic, +Unit, "analyze %n", (1 => +Lib_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; if (Main or Flags.List_All) and then Flags.List_Sem then Disp_Vhdl.Disp_Vhdl (Unit); end if; Post_Sems.Post_Sem_Checks (Unit); if Errorout.Nbr_Errors > 0 then raise Compilation_Error; end if; if Flags.Flag_Elaborate or else ((Main or Flags.List_All) and then Flags.List_Canon) then if Flags.Verbose then Report_Msg (Msgid_Note, Semantic, No_Location, "canonicalize %n", (1 => +Lib_Unit)); end if; Canon.Canonicalize (Unit); -- FIXME: for Main only ? if Get_Kind (Lib_Unit) = Iir_Kind_Package_Declaration and then not Get_Need_Body (Lib_Unit) and then Get_Need_Instance_Bodies (Lib_Unit) then -- Create the bodies for instances Set_Package_Instantiation_Bodies_Chain (Lib_Unit, Canon.Create_Instantiation_Bodies (Lib_Unit)); end if; if (Main or Flags.List_All) and then Flags.List_Canon then Disp_Vhdl.Disp_Vhdl (Unit); end if; end if; if Flags.Flag_Elaborate then if Get_Kind (Lib_Unit) = Iir_Kind_Architecture_Body then Config := Canon.Create_Default_Configuration_Declaration (Lib_Unit); Set_Default_Configuration_Declaration (Lib_Unit, Config); end if; end if; end Finish_Compilation; procedure Compile_Init is begin Options.Initialize; Flag_Ieee := Lib_Standard; Back_End.Finish_Compilation := Finish_Compilation'Access; Flag_Verbose := False; end Compile_Init; procedure Init (Cmd : in out Command_Lib) is pragma Unreferenced (Cmd); begin Compile_Init; 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); Opt : constant String (1 .. Option'Length) := Option; begin Res := Option_Bad; if Opt = "-v" and then Flag_Verbose = False then Flag_Verbose := True; Res := Option_Ok; elsif Opt'Length > 9 and then Opt (1 .. 9) = "--PREFIX=" then Switch_Prefix_Path := new String'(Opt (10 .. Opt'Last)); Res := Option_Ok; elsif Opt = "--ieee=synopsys" then Flag_Ieee := Lib_Synopsys; Res := Option_Ok; elsif Opt = "--ieee=mentor" then Flag_Ieee := Lib_Mentor; Res := Option_Ok; elsif Opt = "--ieee=none" then Flag_Ieee := Lib_None
/*
 *  yosys -- Yosys Open SYnthesis Suite
 *
 *  Copyright (C) 2012  Clifford Wolf <clifford@clifford.at>
 *
 *  Permission to use, copy, modify, and/or distribute this software for any
 *  purpose with or without fee is hereby granted, provided that the above
 *  copyright notice and this permission notice appear in all copies.
 *
 *  THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 *  WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 *  MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 *  ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 *  WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 *  ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 *  OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *
 */
// Input buffer map
module \$__inpad (input I, output O);
    twentynm_io_ibuf _TECHMAP_REPLACE_ (.o(O), .i(I), .ibar(1'b0));
endmodule

// Output buffer map
module \$__outpad (input I, output O);
    twentynm_io_obuf _TECHMAP_REPLACE_ (.o(O), .i(I), .oe(1'b1));
endmodule

// LUT Map
module \$lut (A, Y);
   parameter WIDTH  = 0;
   parameter LUT    = 0;
   input [WIDTH-1:0] A;
   output            Y;
   generate
      if (WIDTH == 1) begin
	   assign Y = ~A[0]; // Not need to spend 1 logic cell for such an easy function
      end else
      if (WIDTH == 2) begin
           twentynm_lcell_comb #(.lut_mask({16{LUT}}), .shared_arith("off"), .extended_lut("off"))
           _TECHMAP_REPLACE_ (.combout(Y), .dataa(A[0]), .datab(A[1]), .datac(1'b1),.datad(1'b1), .datae(1'b1), .dataf(1'b1), .datag(1'b1));
      end /*else
      if(WIDTH == 3) begin
	   fiftyfivenm_lcell_comb #(.lut_mask({2{LUT}}), .sum_lutc_input("datac")) _TECHMAP_REPLACE_ (.combout(Y), .dataa(A[0]), .datab(A[1]), .datac(A[2]),.datad(1'b1));
      end else
      if(WIDTH == 4) begin
	   fiftyfivenm_lcell_comb #(.lut_mask(LUT), .sum_lutc_input("datac")) _TECHMAP_REPLACE_ (.combout(Y), .dataa(A[0]), .datab(A[1]), .datac(A[2]),.datad(A[3]));
      end*/ else
	   wire _TECHMAP_FAIL_ = 1;
   endgenerate
endmodule //
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 Is_Directory_Separator (Filename (I)) 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; In_Work : Boolean := True) return String_Access is use Name_Table; begin if In_Work then return new String'(Image (Libraries.Work_Directory) & Get_Base_Name (File) & Suffix); else return new String'(File & Suffix); end if; 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 -- '-d' is for compatibility. 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 "--dir [LIBs] Disp contents of the libraries"; end Get_Short_Help; procedure Perform_Action (Cmd : in out Command_Dir; Args : Argument_List) is pragma Unreferenced (Cmd); begin Setup_Libraries (True); if Args'Length = 0 then Disp_Library (Std_Names.Name_Work); else for I in Args'Range loop Disp_Library (Name_Table.Get_Identifier (Args (I).all)); end loop; end if; end Perform_Action; -- Command Find. type Command_Find is new Command_Lib with null record; function Decode_Command (Cmd : Command_Find; Name : String) return Boolean; function Get_Short_Help (Cmd : Command_Find) return String; procedure Perform_Action (Cmd : in out Command_Find; Args : Argument_List); function Decode_Command (Cmd : Command_Find; Name : String) return Boolean is pragma Unreferenced (Cmd); begin return Name = "-f"; end Decode_Command; function Get_Short_Help (Cmd : Command_Find) return String is pragma Unreferenced (Cmd); begin return "-f FILEs Disp units in FILES"; end Get_Short_Help; -- Return TRUE is UNIT can be at the apex of a design hierarchy. function Is_Top_Entity (Unit : Iir) return Boolean is begin if Get_Kind (Unit) /= Iir_Kind_Entity_Declaration then return False; end if; if Get_Port_Chain (Unit) /= Null_Iir then return False; end if; if Get_Generic_Chain (Unit) /= Null_Iir then return False; end if; return True; end Is_Top_Entity; -- Disp contents design files FILES. procedure Perform_Action (Cmd : in out Command_Find; Args : Argument_List) is pragma Unreferenced (Cmd); use Name_Table; Id : Name_Id; Design_File : Iir_Design_File; Unit : Iir; Lib : Iir; Flag_Add : constant Boolean := False; begin Flags.Bootstrap := True; Libraries.Load_Std_Library; Libraries.Load_Work_Library; for I in Args'Range loop Id := Get_Identifier (Args (I).all); Design_File := Libraries.Load_File (Id); if Design_File /= Null_Iir then Unit := Get_First_Design_Unit (Design_File); while Unit /= Null_Iir loop Lib := Get_Library_Unit (Unit); Disp_Library_Unit (Lib); if Is_Top_Entity (Lib) then Put (" **"); end if; New_Line; if Flag_Add then Libraries.Add_Design_Unit_Into_Library (Unit); end if; Unit := Get_Chain (Unit); end loop; end if; end loop; if Flag_Add then Libraries.Save_Work_Library; end if; end Perform_Action; -- Command Import. type Command_Import is new Command_Lib with null record; function Decode_Command (Cmd : Command_Import; Name : String) return Boolean; function Get_Short_Help (Cmd : Command_Import) return String; procedure Perform_Action (Cmd : in out Command_Import; Args : Argument_List); function Decode_Command (Cmd : Command_Import; Name : String) return Boolean is pragma Unreferenced (Cmd); begin return Name = "-i"; end Decode_Command; function Get_Short_Help (Cmd : Command_Import) return String is pragma Unreferenced (Cmd); begin return "-i [OPTS] FILEs Import units of FILEs"; end Get_Short_Help; procedure Perform_Action (Cmd : in out Command_Import; Args : Argument_List) is pragma Unreferenced (Cmd); Id : Name_Id; Design_File : Iir_Design_File; Unit : Iir; Next_Unit : Iir; Lib : Iir; begin Setup_Libraries (True); -- Parse all files. for I in Args'Range loop Id := Name_Table.Get_Identifier (Args (I).all); Design_File := Libraries.Load_File (Id); if Design_File /= Null_Iir then Unit := Get_First_Design_Unit (Design_File); while Unit /= Null_Iir loop if Flag_Verbose then Lib := Get_Library_Unit (Unit); Disp_Library_Unit (Lib); if Is_Top_Entity (Lib) then Put (" **"); end if; New_Line; end if; Next_Unit := Get_Chain (Unit); Set_Chain (Unit, Null_Iir); Libraries.Add_Design_Unit_Into_Library (Unit); Unit := Next_Unit; end loop; end if; end loop; -- Analyze all files. if False then Design_File := Get_Design_File_Chain (Libraries.Work_Library); while Design_File /= Null_Iir loop Unit := Get_First_Design_Unit (Design_File); while Unit /= Null_Iir loop case Get_Date (Unit) is when Date_Valid | Date_Analyzed => null; when Date_Parsed => Back_End.Finish_Compilation (Unit, False); when others => raise Internal_Error; end case; Unit := Get_Chain (Unit); end loop; Design_File := Get_Chain (Design_File); end loop; end if; Libraries.Save_Work_Library; exception when Errorout.Compilation_Error => Error ("importation has failed due to compilation error"); raise; end Perform_Action; -- Command Check_Syntax. type Command_Check_Syntax is new Command_Lib with null record; function Decode_Command (Cmd : Command_Check_Syntax; Name : String) return Boolean; function Get_Short_Help (Cmd : Command_Check_Syntax) return String; procedure Perform_Action (Cmd : in out Command_Check_Syntax; Args : Argument_List); function Decode_Command (Cmd : Command_Check_Syntax; Name : String) return Boolean is pragma Unreferenced (Cmd); begin return Name = "-s"; end Decode_Command; function Get_Short_Help (Cmd : Command_Check_Syntax) return String is pragma Unreferenced (Cmd); begin return "-s [OPTS] FILEs Check syntax of FILEs"; end Get_Short_Help; procedure Analyze_One_File (File_Name : String) is Id : Name_Id; Design_File : Iir_Design_File; Unit : Iir; Next_Unit : Iir; begin Id := Name_Table.Get_Identifier (File_Name); if Flag_Verbose then Put (File_Name); Put_Line (":"); end if; Design_File := Libraries.Load_File (Id); if Design_File = Null_Iir then raise Errorout.Compilation_Error; end if; Unit := Get_First_Design_Unit (Design_File); while Unit /= Null_Iir loop if Flag_Verbose then Put (' '); Disp_Library_Unit (Get_Library_Unit (Unit)); New_Line; end if; -- Sem, canon, annotate a design unit. Back_End.Finish_Compilation (Unit, True); Next_Unit := Get_Chain (Unit); if Errorout.Nbr_Errors = 0 then Set_Chain (Unit, Null_Iir); Libraries.Add_Design_Unit_Into_Library (Unit); end if; Unit := Next_Unit; end loop; if Errorout.Nbr_Errors > 0 then raise Errorout.Compilation_Error; end if; end Analyze_One_File; procedure Analyze_Files (Files : Argument_List; Save_Library : Boolean) is begin Setup_Libraries (True); -- Parse all files. for I in Files'Range loop Analyze_One_File (Files (I).all); end loop; if Save_Library then Libraries.Save_Work_Library; end if; end Analyze_Files; procedure Perform_Action (Cmd : in out Command_Check_Syntax; Args : Argument_List) is pragma Unreferenced (Cmd); begin Analyze_Files (Args, False); end Perform_Action; -- Command --clean: remove object files. type Command_Clean is new Command_Lib with null record; function Decode_Command (Cmd : Command_Clean; Name : String) return Boolean; function Get_Short_Help (Cmd : Command_Clean) return String; procedure Perform_Action (Cmd : in out Command_Clean; Args : Argument_List); function Decode_Command (Cmd : Command_Clean; Name : String) return Boolean is pragma Unreferenced (Cmd); begin return Name = "--clean"; end Decode_Command; function Get_Short_Help (Cmd : Command_Clean) return String is pragma Unreferenced (Cmd); begin return "--clean Remove generated files"; end Get_Short_Help; procedure Delete (Str : String) is Status : Boolean; begin Delete_File (Str'Address, Status); if Flag_Verbose and Status then Put_Line ("delete " & Str (Str'First .. Str'Last - 1)); end if; end Delete; procedure Perform_Action (Cmd : in out Command_Clean; Args : Argument_List) is pragma Unreferenced (Cmd); use Name_Table; procedure Delete_Asm_Obj (Str : String) is begin Delete (Str & Get_Object_Suffix.all & Nul); Delete (Str & Asm_Suffix & Nul); end Delete_Asm_Obj; procedure Delete_Top_Unit (Str : String) is begin -- Delete elaboration file Delete_Asm_Obj (Elab_Prefix & Str); -- Delete file list. Delete (Str & List_Suffix & Nul); -- Delete executable. Delete (Str & Nul); end Delete_Top_Unit; File : Iir_Design_File; Design_Unit : Iir_Design_Unit; Lib_Unit : Iir; Str : String_Access; begin if Args'Length /= 0 then Error ("command '--clean' does not accept any argument"); raise Option_Error; end if; Flags.Bootstrap := True; -- Load libraries. Libraries.Load_Std_Library; Libraries.Load_Work_Library; File := Get_Design_File_Chain (Libraries.Work_Library); while File /= Null_Iir loop -- Delete compiled file. Str := Append_Suffix (Image (Get_Design_File_Filename (File)), ""); Delete_Asm_Obj (Str.all); Free (Str); -- Try any possible top-level names Design_Unit := Get_First_Design_Unit (File); while Design_Unit /= Null_Iir loop Lib_Unit := Get_Library_Unit (Design_Unit); case Get_Kind (Lib_Unit) is when Iir_Kind_Entity_Declaration | Iir_Kind_Configuration_Declaration => Delete_Top_Unit (Image (Get_Identifier (Lib_Unit))); when Iir_Kind_Architecture_Body => Delete_Top_Unit (Image (Get_Entity_Identifier_Of_Architecture (Lib_Unit)) & '-' & Image (Get_Identifier (Lib_Unit))); when others => null; end case; Design_Unit := Get_Chain (Design_Unit); end loop; File := Get_Chain (File); end loop; end Perform_Action; -- Command --remove: remove object file and library file. type Command_Remove is new Command_Clean with null record; function Decode_Command (Cmd : Command_Remove; Name : String) return Boolean; function Get_Short_Help (Cmd : Command_Remove) return String; procedure Perform_Action (Cmd : in out Command_Remove; Args : Argument_List); function Decode_Command (Cmd : Command_Remove; Name : String) return Boolean is pragma Unreferenced (Cmd); begin return Name = "--remove"; end Decode_Command; function Get_Short_Help (Cmd : Command_Remove) return String is pragma Unreferenced (Cmd); begin return "--remove Remove generated files and library file"; end Get_Short_Help; procedure Perform_Action (Cmd : in out Command_Remove; Args : Argument_List) is use Name_Table; begin if Args'Length /= 0 then Error ("command '--remove' does not accept any argument"); raise Option_Error; end if; Perform_Action (Command_Clean (Cmd), Args); Delete (Image (Libraries.Work_Directory) & Libraries.Library_To_File_Name (Libraries.Work_Library) & Nul); end Perform_Action; -- Command --copy: copy work library to current directory. type Command_Copy is new Command_Lib with null record; function Decode_Command (Cmd : Command_Copy; Name : String) return Boolean; function Get_Short_Help (Cmd : Command_Copy) return String; procedure Perform_Action (Cmd : in out Command_Copy; Args : Argument_List); function Decode_Command (Cmd : Command_Copy; Name : String) return Boolean is pragma Unreferenced (Cmd); begin return Name = "--copy"; end Decode_Command; function Get_Short_Help (Cmd : Command_Copy) return String is pragma Unreferenced (Cmd); begin return "--copy Copy work library to current directory"; end Get_Short_Help; procedure Perform_Action (Cmd : in out Command_Copy; Args : Argument_List) is pragma Unreferenced (Cmd); use Name_Table; use Libraries; File : Iir_Design_File; Dir : Name_Id; begin if Args'Length /= 0 then Error ("command '--copy' does not accept any argument"); raise Option_Error; end if; Setup_Libraries (False); Libraries.Load_Std_Library; Dir := Work_Directory; Work_Directory := Null_Identifier; Libraries.Load_Work_Library; Work_Directory := Dir; Dir := Get_Library_Directory (Libraries.Work_Library); if Dir = Name_Nil or else Dir = Files_Map.Get_Home_Directory then Error ("cannot copy library on itself (use --remove first)"); raise Option_Error; end if; File := Get_Design_File_Chain (Libraries.Work_Library); while File /= Null_Iir loop -- Copy object files (if any). declare Basename : constant String := Get_Base_Name (Image (Get_Design_File_Filename (File))); Src : String_Access; Dst : String_Access; Success : Boolean; pragma Unreferenced (Success); begin Src := new String'(Image (Dir) & Basename & Get_Object_Suffix.all); Dst := new String'(Basename & Get_Object_Suffix.all); Copy_File (Src.all, Dst.all, Success, Overwrite, Full); -- Be silent in case of error. Free (Src); Free (Dst); end; if Get_Design_File_Directory (File) = Name_Nil then Set_Design_File_Directory (File, Dir); end if; File := Get_Chain (File); end loop; Libraries.Work_Directory := Name_Nil; Libraries.Save_Work_Library; end Perform_Action; -- Command --disp-standard. type Command_Disp_Standard is new Command_Lib with null record; function Decode_Command (Cmd : Command_Disp_Standard; Name : String) return Boolean; function Get_Short_Help (Cmd : Command_Disp_Standard) return String; procedure Perform_Action (Cmd : in out Command_Disp_Standard; Args : Argument_List); function Decode_Command (Cmd : Command_Disp_Standard; Name : String) return Boolean is pragma Unreferenced (Cmd); begin return Name = "--disp-standard"; end Decode_Command; function Get_Short_Help (Cmd : Command_Disp_Standard) return String is pragma Unreferenced (Cmd); begin return "--disp-standard Disp std.standard in pseudo-vhdl"; end Get_Short_Help; procedure Perform_Action (Cmd : in out Command_Disp_Standard; Args : Argument_List) is pragma Unreferenced (Cmd); begin if Args'Length /= 0 then Error ("command '--disp-standard' does not accept any argument"); raise Option_Error; end if; Flags.Bootstrap := True; Libraries.Load_Std_Library; Disp_Vhdl.Disp_Vhdl (Std_Package.Std_Standard_Unit); end Perform_Action; procedure Load_All_Libraries_And_Files is use Files_Map; use Libraries; use Errorout; procedure Extract_Library_Clauses (Unit : Iir_Design_Unit) is Lib1 : Iir_Library_Declaration; pragma Unreferenced (Lib1); Ctxt_Item : Iir; begin -- Extract library clauses. Ctxt_Item := Get_Context_Items (Unit); while Ctxt_Item /= Null_Iir loop if Get_Kind (Ctxt_Item) = Iir_Kind_Library_Clause then Lib1 := Get_Library (Get_Identifier (Ctxt_Item), Get_Location (Ctxt_Item)); end if; Ctxt_Item := Get_Chain (Ctxt_Item); end loop; end Extract_Library_Clauses; Lib : Iir_Library_Declaration; Fe : Source_File_Entry; File, Next_File : Iir_Design_File; Unit, Next_Unit : Iir_Design_Unit; Design_File : Iir_Design_File; Old_Work : Iir_Library_Declaration; begin Lib := Std_Library; Lib := Get_Chain (Lib); Old_Work := Work_Library; while Lib /= Null_Iir loop -- Design units are always put in the work library. Work_Library := Lib; File := Get_Design_File_Chain (Lib); while File /= Null_Iir loop Next_File := Get_Chain (File); Fe := Load_Source_File (Get_Design_File_Directory (File), Get_Design_File_Filename (File)); if Fe = No_Source_File_Entry then -- FIXME: should remove all the design file from the library. null; elsif Is_Eq (Get_File_Checksum (Fe), Get_File_Checksum (File)) then -- File has not been modified. -- Extract libraries. -- Note: we can't parse it only, since we need to keep the -- date. Unit := Get_First_Design_Unit (File); while Unit /= Null_Iir loop Load_Parse_Design_Unit (Unit, Null_Iir); Extract_Library_Clauses (Unit); Unit := Get_Chain (Unit); end loop; else -- File has been modified. -- Parse it. Design_File := Load_File (Fe); -- Exit now in case of parse error. if Design_File = Null_Iir or else Nbr_Errors > 0 then raise Compilation_Error; end if; Unit := Get_First_Design_Unit (Design_File); while Unit /= Null_Iir loop Extract_Library_Clauses (Unit); Next_Unit := Get_Chain (Unit); Set_Chain (Unit, Null_Iir); Add_Design_Unit_Into_Library (Unit); Unit := Next_Unit; end loop; end if; File := Next_File; end loop; Lib := Get_Chain (Lib); end loop; Work_Library := Old_Work; end Load_All_Libraries_And_Files; -- Check the Elab_Flag is not set on design units of LIB. procedure Check_No_Elab_Flag (Lib : Iir_Library_Declaration) is File : Iir_Design_File; Unit : Iir_Design_Unit; begin File := Get_Design_File_Chain (Lib); while File /= Null_Iir loop Unit := Get_First_Design_Unit (File); while Unit /= Null_Iir loop if Get_Elab_Flag (Unit) then raise Internal_Error; end if; Unit := Get_Chain (Unit); end loop; File := Get_Chain (File); end loop; end Check_No_Elab_Flag; function Build_Dependence (Prim : String_Access; Sec : String_Access) return Iir_List is procedure Build_Dependence_List (File : Iir_Design_File; List : Iir_List) is El : Iir_Design_File; Depend_List : Iir_List; begin if Get_Elab_Flag (File) then return; end if; Set_Elab_Flag (File, True); Depend_List := Get_File_Dependence_List (File); if Depend_List /= Null_Iir_List then for I in Natural loop El := Get_Nth_Element (Depend_List, I); exit when El = Null_Iir; Build_Dependence_List (El, List); end loop; end if; Append_Element (List, File); end Build_Dependence_List; use Configuration; use Name_Table; Top : Iir; Primary_Id : Name_Id; Secondary_Id : Name_Id; File : Iir_Design_File; Unit : Iir; Files_List : Iir_List; begin Check_No_Elab_Flag (Libraries.Work_Library); Primary_Id := Get_Identifier (Prim.all); if Sec /= null then Secondary_Id := Get_Identifier (Sec.all); else Secondary_Id := Null_Identifier; end if; if True then -- Load the world. Load_All_Libraries_And_Files; else -- Re-parse modified files in order configure could find all design -- units. declare use Files_Map; Fe : Source_File_Entry; Next_File : Iir_Design_File; Design_File : Iir_Design_File; begin File := Get_Design_File_Chain (Libraries.Work_Library); while File /= Null_Iir loop Next_File := Get_Chain (File); Fe := Load_Source_File (Get_Design_File_Directory (File), Get_Design_File_Filename (File)); if Fe = No_Source_File_Entry then -- FIXME: should remove all the design file from -- the library. null; else if not Is_Eq (Get_File_Checksum (Fe), Get_File_Checksum (File)) then -- FILE has been modified. Design_File := Libraries.Load_File (Fe); if Design_File /= Null_Iir then Libraries.Add_Design_File_Into_Library (Design_File); end if; end if; end if; File := Next_File; end loop; end; end if; Flags.Flag_Elaborate := True; Flags.Flag_Elaborate_With_Outdated := True; Flag_Load_All_Design_Units := True; Flag_Build_File_Dependence := True; Top := Configure (Primary_Id, Secondary_Id); if Top = Null_Iir then -- Error during configuration (primary unit not found). raise Option_Error; end if; -- Add unused design units (and their dependencies). declare N : Natural; begin N := Design_Units.First; while N <= Design_Units.Last loop Unit := Design_Units.Table (N); N := N + 1; File := Get_Design_File (Unit); if not Get_Elab_Flag (File) then Set_Elab_Flag (File, True); Unit := Get_First_Design_Unit (File); while Unit /= Null_Iir loop if not Get_Elab_Flag (Unit) then Add_Design_Unit (Unit, Null_Iir); end if; Unit := Get_Chain (Unit); end loop; end if; end loop; end; -- Clear elab flag on design files (as it is used by below by -- Build_Dependence_List). for I in reverse Design_Units.First .. Design_Units.Last loop Unit := Design_Units.Table (I); File := Get_Design_File (Unit); Set_Elab_Flag (File, False); end loop; -- Create a list of files, from the last to the first. Files_List := Create_Iir_List; for I in Design_Units.First .. Design_Units.Last loop Unit := Design_Units.Table (I); File := Get_Design_File (Unit); Build_Dependence_List (File, Files_List); end loop; return Files_List; end Build_Dependence; function Source_File_Modified (File : Iir_Design_File) return Boolean is use Files_Map; Fe : Source_File_Entry; begin -- 2) file has been modified. Fe := Load_Source_File (Get_Design_File_Directory (File), Get_Design_File_Filename (File)); if not Is_Eq (Get_File_Checksum (Fe), Get_File_Checksum (File)) then if Flag_Verbose then Put_Line ("file " & Name_Table.Image (Get_File_Name (Fe)) & " has been modified"); end if; return True; else return False; end if; end Source_File_Modified; function Is_File_Outdated (File : Iir_Design_File) return Boolean is Unit : Iir; Lib_Unit : Iir; begin Unit := Get_First_Design_Unit (File); while Unit /= Null_Iir loop Lib_Unit := Get_Library_Unit (Unit); if Get_Kind (Lib_Unit) = Iir_Kind_Configuration_Declaration and then Get_Identifier (Lib_Unit) = Null_Identifier then -- Do not consider default configurations (there is no user code -- for them). null; elsif Get_Date (Unit) not in Date_Valid then -- Unit not yet analyzed: if Flag_Verbose then Disp_Library_Unit (Get_Library_Unit (Unit)); Put_Line (" was not analyzed"); end if; return True; else -- Check if one of the dependence is newer declare Depends : constant Iir_List := Get_Dependence_List (Unit); Stamp : constant Time_Stamp_Id := Get_Analysis_Time_Stamp (File); El : Iir; Dep : Iir_Design_Unit; Dep_File : Iir_Design_File; begin if Depends /= Null_Iir_List then for I in Natural loop El := Get_Nth_Element (Depends, I); exit when El = Null_Iir; Dep := Libraries.Find_Design_Unit (El); if Dep = Null_Iir then if Flag_Verbose then Disp_Library_Unit (Unit); Put (" depends on an unknown unit "); Disp_Library_Unit (El); New_Line; end if; return True; end if; Dep_File := Get_Design_File (Dep); if Dep /= Std_Package.Std_Standard_Unit and then Files_Map.Is_Gt (Get_Analysis_Time_Stamp (Dep_File), Stamp) then if Flag_Verbose then Disp_Library_Unit (Get_Library_Unit (Unit)); Put (" depends on: "); Disp_Library_Unit (Get_Library_Unit (Dep)); Put (" (more recently analyzed)"); New_Line; end if; return True; end if; end loop; end if; end; end if; Unit := Get_Chain (Unit); end loop; return False; end Is_File_Outdated; -- Convert NAME to lower cases, unless it is an extended identifier. function Convert_Name (Name : String_Access) return String_Access is use Name_Table; function Is_Bad_Unit_Name return Boolean is begin if Nam_Length = 0 then return True; end if; -- Don't try to handle extended identifier. if Nam_Buffer (1) = '\' then return False; end if; -- Look for suspicious characters. -- Do not try to be exhaustive as the correct check will be done -- by convert_identifier. for I in 1 .. Nam_Length loop case Nam_Buffer (I) is when '.' | '/' | '\' => return True; when others => null; end case; end loop; return False; end Is_Bad_Unit_Name; function Is_A_File_Name return Boolean is begin -- Check .vhd if Nam_Length > 4 and then Nam_Buffer (Nam_Length - 3 .. Nam_Length) = ".vhd" then return True; end if; -- Check .vhdl if Nam_Length > 5 and then Nam_Buffer (Nam_Length - 4 .. Nam_Length) = ".vhdl" then return True; end if; -- Check ../ if Nam_Length > 3 and then Nam_Buffer (1 .. 3) = "../" then return True; end if; -- Check ..\ if Nam_Length > 3 and then Nam_Buffer (1 .. 3) = "..\" then return True; end if; -- Should try to find the file ? return False; end Is_A_File_Name; begin Nam_Length := Name'Length; Nam_Buffer (1 .. Nam_Length) := Name.all; -- Try to identifier bad names (such as file names), so that -- friendly message can be displayed. if Is_Bad_Unit_Name then Errorout.Error_Msg_Option_NR ("bad unit name '" & Name.all & "'"); if Is_A_File_Name then Errorout.Error_Msg_Option_NR ("(a unit name is required instead of a filename)"); end if; raise Option_Error; end if; Scanner.Convert_Identifier; return new String'(Nam_Buffer (1 .. Nam_Length)); end Convert_Name; procedure Extract_Elab_Unit (Cmd_Name : String; Args : Argument_List; Next_Arg : out Natural) is begin if Args'Length = 0 then Error ("command '" & Cmd_Name & "' required an unit name"); raise Option_Error; end if; Prim_Name := Convert_Name (Args (Args'First)); Next_Arg := Args'First + 1; Sec_Name := null; if Args'Length >= 2 then declare Sec : constant String_Access := Args (Next_Arg); begin if Sec (Sec'First) /= '-' then Sec_Name := Convert_Name (Sec); Next_Arg := Args'First + 2; end if; end; end if; end Extract_Elab_Unit; procedure Register_Commands is begin Register_Command (new Command_Import); Register_Command (new Command_Check_Syntax); Register_Command (new Command_Dir); Register_Command (new Command_Find); Register_Command (new Command_Clean); Register_Command (new Command_Remove); Register_Command (new Command_Copy); Register_Command (new Command_Disp_Standard); end Register_Commands; end Ghdllocal;