diff options
Diffstat (limited to 'src/ghdldrv')
-rw-r--r-- | src/ghdldrv/ghdlcomp.adb | 56 | ||||
-rw-r--r-- | src/ghdldrv/ghdldrv.adb | 182 | ||||
-rw-r--r-- | src/ghdldrv/ghdllocal.adb | 106 | ||||
-rw-r--r-- | src/ghdldrv/ghdllocal.ads | 8 |
4 files changed, 196 insertions, 156 deletions
diff --git a/src/ghdldrv/ghdlcomp.adb b/src/ghdldrv/ghdlcomp.adb index ef81487..33f1b8b 100644 --- a/src/ghdldrv/ghdlcomp.adb +++ b/src/ghdldrv/ghdlcomp.adb @@ -516,6 +516,7 @@ package body Ghdlcomp is Next_Arg : Natural; Date : Date_Type; Unit : Iir_Design_Unit; + Lib : Iir_Library_Declaration; begin Extract_Elab_Unit ("-m", Args, Next_Arg); Setup_Libraries (True); @@ -523,12 +524,26 @@ package body Ghdlcomp is -- Create list of files. Files_List := Build_Dependence (Prim_Name, Sec_Name); + -- Unmark all libraries. + Lib := Libraries.Std_Library; + while Lib /= Null_Iir loop + Set_Elab_Flag (Lib, False); + Lib := Get_Chain (Lib); + end loop; + Date := Get_Date (Libraries.Work_Library); for I in Natural loop File := Get_Nth_Element (Files_List, I); exit when File = Null_Iir; - if Get_Library (File) = Libraries.Work_Library then + if File = Std_Package.Std_Standard_File then + null; + elsif Source_File_Modified (File) + or else Is_File_Outdated (File) + then + Lib := Get_Library (File); + Date := Get_Date (Lib); + -- Mark this file as analyzed. Set_Analysis_Time_Stamp (File, Files_Map.Get_Os_Time_Stamp); @@ -542,10 +557,45 @@ package body Ghdlcomp is end if; Unit := Get_Chain (Unit); end loop; + + Set_Date (Lib, Date); + + -- Need to be written to disk. + Set_Elab_Flag (Lib, True); end if; end loop; - Set_Date (Libraries.Work_Library, Date); - Libraries.Save_Work_Library; + + -- Save modified libraries. + if Get_Elab_Flag (Libraries.Work_Library) then + Libraries.Save_Work_Library; + Set_Elab_Flag (Libraries.Work_Library, False); + end if; + + declare + use Libraries; + Old_Work_Library : constant Iir_Library_Declaration := Work_Library; + Old_Work_Library_Name : constant Name_Id := Work_Library_Name; + Old_Work_Directory : constant Name_Id := Work_Directory; + begin + Lib := Libraries.Std_Library; + while Lib /= Null_Iir loop + if Get_Elab_Flag (Lib) then + if Lib = Std_Library then + Error ("need to rebuild std library"); + raise Compile_Error; + end if; + Work_Library := Lib; + Work_Library_Name := Get_Identifier (Lib); + Work_Directory := Get_Library_Directory (Lib); + Libraries.Save_Work_Library; + Set_Elab_Flag (Lib, False); + end if; + Lib := Get_Chain (Lib); + end loop; + Work_Library := Old_Work_Library; + Work_Library_Name := Old_Work_Library_Name; + Work_Directory := Old_Work_Directory; + end; exception when Compilation_Error => if Flag_Expect_Failure then diff --git a/src/ghdldrv/ghdldrv.adb b/src/ghdldrv/ghdldrv.adb index 7e418d6..2a32595 100644 --- a/src/ghdldrv/ghdldrv.adb +++ b/src/ghdldrv/ghdldrv.adb @@ -364,130 +364,6 @@ package body Ghdldrv is & Get_Object_Suffix.all; end Get_Object_Filename; - Last_Stamp : Time_Stamp_Id; - Last_Stamp_File : Iir; - - function Is_File_Outdated (Design_File : Iir_Design_File) return Boolean - is - use Files_Map; - - Name : Name_Id; - - File : Source_File_Entry; - begin - -- Std.Standard is never outdated. - if Design_File = Std_Package.Std_Standard_File then - return False; - end if; - - Name := Get_Design_File_Filename (Design_File); - declare - Obj_Pathname : String := Get_Object_Filename (Design_File) & Nul; - Stamp : Time_Stamp_Id; - begin - Stamp := Get_File_Time_Stamp (Obj_Pathname'Address); - - -- If the object file does not exist, recompile the file. - if Stamp = Null_Time_Stamp then - if Flag_Verbose then - Put_Line ("no object file for " & Image (Name)); - end if; - return True; - end if; - - -- Keep the time stamp of the most recently analyzed unit. - if Last_Stamp = Null_Time_Stamp - or else Is_Gt (Stamp, Last_Stamp) - then - Last_Stamp := Stamp; - Last_Stamp_File := Design_File; - end if; - end; - - -- 2) file has been modified. - File := Load_Source_File (Get_Design_File_Directory (Design_File), - Get_Design_File_Filename (Design_File)); - if not Is_Eq (Get_File_Time_Stamp (File), - Get_File_Time_Stamp (Design_File)) - then - if Flag_Verbose then - Put_Line ("file " & Image (Get_File_Name (File)) - & " has been modified"); - end if; - return True; - end if; - - return False; - end Is_File_Outdated; - - function Is_Unit_Outdated (Unit : Iir_Design_Unit) return Boolean - is - Design_File : Iir_Design_File; - begin - -- Std.Standard is never outdated. - if Unit = Std_Package.Std_Standard_Unit then - return False; - end if; - - Design_File := Get_Design_File (Unit); - - -- 1) not yet analyzed: - if Get_Date (Unit) not in Date_Valid then - if Flag_Verbose then - Disp_Library_Unit (Get_Library_Unit (Unit)); - Put_Line (" was not analyzed"); - end if; - return True; - end if; - - -- 3) the object file does not exist. - -- Already checked. - - -- 4) one of the dependence is newer - declare - Depends : Iir_List; - El : Iir; - Dep : Iir_Design_Unit; - Stamp : Time_Stamp_Id; - Dep_File : Iir_Design_File; - begin - Depends := Get_Dependence_List (Unit); - Stamp := Get_Analysis_Time_Stamp (Design_File); - 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; - - return False; - end Is_Unit_Outdated; - procedure Add_Argument (Inst : in out Instance; Arg : String_Access) is begin @@ -1381,6 +1257,40 @@ package body Ghdldrv is end if; end Decode_Option; + Last_Stamp : Time_Stamp_Id; + Last_Stamp_File : Iir; + + function Missing_Object_File (Design_File : Iir_Design_File) return Boolean + is + use Files_Map; + + Name : constant Name_Id := Get_Design_File_Filename (Design_File); + Obj_Pathname : constant String := + Get_Object_Filename (Design_File) & Nul; + Stamp : Time_Stamp_Id; + File : Source_File_Entry; + begin + Stamp := Get_File_Time_Stamp (Obj_Pathname'Address); + + -- If the object file does not exist, recompile the file. + if Stamp = Null_Time_Stamp then + if Flag_Verbose then + Put_Line ("no object file for " & Image (Name)); + end if; + return True; + end if; + + -- Keep the time stamp of the most recently analyzed unit. + if Last_Stamp = Null_Time_Stamp + or else Is_Gt (Stamp, Last_Stamp) + then + Last_Stamp := Stamp; + Last_Stamp_File := Design_File; + end if; + + return False; + end Missing_Object_File; + procedure Perform_Action (Cmd : in out Command_Make; Args : Argument_List) is use Configuration; @@ -1463,25 +1373,15 @@ package body Ghdldrv is File := Get_Nth_Element (Files_List, I); exit when File = Null_Iir; - Need_Analyze := False; - if Is_File_Outdated (File) then + if File = Std_Package.Std_Standard_File then + Need_Analyze := False; + elsif Missing_Object_File (File) + or else Source_File_Modified (File) + or else Is_File_Outdated (File) + then Need_Analyze := True; else - Unit := Get_First_Design_Unit (File); - while Unit /= Null_Iir loop - Lib_Unit := Get_Library_Unit (Unit); - -- Check if the unit is outdated (except for default - -- configurations). - if not (Get_Kind (Lib_Unit) = Iir_Kind_Configuration_Declaration - and then Get_Identifier (Lib_Unit) = Null_Identifier) - then - if Is_Unit_Outdated (Unit) then - Need_Analyze := True; - exit; - end if; - end if; - Unit := Get_Chain (Unit); - end loop; + Need_Analyze := False; end if; Lib := Get_Library (File); diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb index ede9526..91bdfac 100644 --- a/src/ghdldrv/ghdllocal.adb +++ b/src/ghdldrv/ghdllocal.adb @@ -15,7 +15,7 @@ -- 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 Ada.Text_IO; use Ada.Text_IO; with Ada.Command_Line; use Ada.Command_Line; with GNAT.Directory_Operations; with Types; use Types; @@ -52,7 +52,6 @@ package body Ghdllocal is (Unit : Iir_Design_Unit; Main : Boolean := False) is use Errorout; - use Ada.Text_IO; Config : Iir_Design_Unit; Lib : Iir; begin @@ -157,7 +156,6 @@ package body Ghdllocal is procedure Disp_Long_Help (Cmd : Command_Lib) is pragma Unreferenced (Cmd); - use Ada.Text_IO; procedure P (Str : String) renames Put_Line; begin P ("Main options (try --options-help for details):"); @@ -440,9 +438,7 @@ package body Ghdllocal is end if; end Setup_Libraries; - procedure Disp_Config_Prefixes - is - use Ada.Text_IO; + procedure Disp_Config_Prefixes is begin Put ("command line prefix (--PREFIX): "); if Switch_Prefix_Path = null then @@ -476,7 +472,6 @@ package body Ghdllocal is procedure Disp_Library_Unit (Unit : Iir) is - use Ada.Text_IO; use Name_Table; Id : Name_Id; begin @@ -518,7 +513,6 @@ package body Ghdllocal is procedure Disp_Library (Name : Name_Id) is - use Ada.Text_IO; use Libraries; Lib : Iir_Library_Declaration; File : Iir_Design_File; @@ -665,7 +659,6 @@ package body Ghdllocal is is pragma Unreferenced (Cmd); - use Ada.Text_IO; use Name_Table; Id : Name_Id; Design_File : Iir_Design_File; @@ -727,7 +720,6 @@ package body Ghdllocal is procedure Perform_Action (Cmd : in out Command_Import; Args : Argument_List) is pragma Unreferenced (Cmd); - use Ada.Text_IO; Id : Name_Id; Design_File : Iir_Design_File; Unit : Iir; @@ -812,7 +804,6 @@ package body Ghdllocal is procedure Analyze_One_File (File_Name : String) is - use Ada.Text_IO; Id : Name_Id; Design_File : Iir_Design_File; Unit : Iir; @@ -896,7 +887,6 @@ package body Ghdllocal is procedure Delete (Str : String) is - use Ada.Text_IO; Status : Boolean; begin Delete_File (Str'Address, Status); @@ -1360,6 +1350,98 @@ package body Ghdllocal is 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_Time_Stamp (Fe), + Get_File_Time_Stamp (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 diff --git a/src/ghdldrv/ghdllocal.ads b/src/ghdldrv/ghdllocal.ads index d64846f..7c5d193 100644 --- a/src/ghdldrv/ghdllocal.ads +++ b/src/ghdldrv/ghdllocal.ads @@ -108,6 +108,14 @@ package Ghdllocal is function Build_Dependence (Prim : String_Access; Sec : String_Access) return Iir_List; + -- Return True iff file FILE has been modified (the file time stamp does + -- no correspond to what was recorded in the library). + function Source_File_Modified (File : Iir_Design_File) return Boolean; + + -- Return True iff FILE need to be analyzed because one of its dependences + -- has been analyzed more recently. + function Is_File_Outdated (File : Iir_Design_File) return Boolean; + Prim_Name : String_Access; Sec_Name : String_Access; |