diff options
author | Tristan Gingold <tgingold@free.fr> | 2018-11-14 18:35:41 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2018-11-14 18:35:41 +0100 |
commit | b6c523106ab498375a7874923742c6b806700a9a (patch) | |
tree | 83f21964f8290a845a9acaba325056f5a420a963 | |
parent | 12ea165c7474ad0a7a486062f816071378492eed (diff) | |
download | ghdl-b6c523106ab498375a7874923742c6b806700a9a.tar.gz ghdl-b6c523106ab498375a7874923742c6b806700a9a.tar.bz2 ghdl-b6c523106ab498375a7874923742c6b806700a9a.zip |
Create sem_lib from libraries.
-rw-r--r-- | src/ghdldrv/ghdlcomp.adb | 11 | ||||
-rw-r--r-- | src/ghdldrv/ghdllocal.adb | 17 | ||||
-rw-r--r-- | src/ghdldrv/ghdlprint.adb | 15 | ||||
-rw-r--r-- | src/ghdldrv/ghdlxml.adb | 3 | ||||
-rw-r--r-- | src/libraries.adb | 379 | ||||
-rw-r--r-- | src/libraries.ads | 51 | ||||
-rw-r--r-- | src/vhdl/configuration.adb | 11 | ||||
-rw-r--r-- | src/vhdl/iirs_utils.adb | 15 | ||||
-rw-r--r-- | src/vhdl/iirs_utils.ads | 4 | ||||
-rw-r--r-- | src/vhdl/sem.adb | 17 | ||||
-rw-r--r-- | src/vhdl/sem_assocs.adb | 3 | ||||
-rw-r--r-- | src/vhdl/sem_decls.adb | 17 | ||||
-rw-r--r-- | src/vhdl/sem_decls.ads | 4 | ||||
-rw-r--r-- | src/vhdl/sem_expr.adb | 3 | ||||
-rw-r--r-- | src/vhdl/sem_inst.adb | 1 | ||||
-rw-r--r-- | src/vhdl/sem_lib.adb | 388 | ||||
-rw-r--r-- | src/vhdl/sem_lib.ads | 41 | ||||
-rw-r--r-- | src/vhdl/sem_names.adb | 8 | ||||
-rw-r--r-- | src/vhdl/sem_specs.adb | 3 | ||||
-rw-r--r-- | src/vhdl/sem_types.adb | 3 | ||||
-rw-r--r-- | src/vhdl/std_package.adb | 1 | ||||
-rw-r--r-- | src/vhdl/translate/ortho_front.adb | 7 | ||||
-rw-r--r-- | src/vhdl/translate/trans-chap12.adb | 5 |
23 files changed, 511 insertions, 496 deletions
diff --git a/src/ghdldrv/ghdlcomp.adb b/src/ghdldrv/ghdlcomp.adb index eb1ef80e3..5ccb1f9ab 100644 --- a/src/ghdldrv/ghdlcomp.adb +++ b/src/ghdldrv/ghdlcomp.adb @@ -25,6 +25,7 @@ with Ada.Text_IO; with Types; with Flags; with Sem; +with Sem_Lib; use Sem_Lib; with Name_Table; with Errorout; use Errorout; with Libraries; @@ -214,7 +215,7 @@ package body Ghdlcomp is Design : Iir; Next_Design : Iir; begin - Res := Libraries.Load_File (Name_Table.Get_Identifier (File)); + Res := Load_File (Name_Table.Get_Identifier (File)); if Errorout.Nbr_Errors > 0 then raise Compilation_Error; end if; @@ -238,7 +239,7 @@ package body Ghdlcomp is Unit : Iir; Next_Unit : Iir; begin - Design_File := Libraries.Load_File (Id); + Design_File := Load_File (Id); if Design_File = Null_Iir or else Errorout.Nbr_Errors > 0 then -- Stop now in case of error (file not found or parse error). return Design_File; @@ -246,7 +247,7 @@ package body Ghdlcomp is Unit := Get_First_Design_Unit (Design_File); while Unit /= Null_Iir loop - Libraries.Finish_Compilation (Unit, True); + Finish_Compilation (Unit, True); Next_Unit := Get_Chain (Unit); @@ -396,7 +397,7 @@ package body Ghdlcomp is -- Parse all files. for I in Args'Range loop Id := Name_Table.Get_Identifier (Args (I).all); - Design_File := Libraries.Load_File (Id); + Design_File := Load_File (Id); if Errorout.Nbr_Errors > 0 then raise Compilation_Error; end if; @@ -410,7 +411,7 @@ package body Ghdlcomp is if Design_File /= Null_Iir then Unit := Get_First_Design_Unit (Design_File); while Unit /= Null_Iir loop - Libraries.Finish_Compilation (Unit, True); + Finish_Compilation (Unit, True); Next_Unit := Get_Chain (Unit); diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb index 19481e88b..022ae98c5 100644 --- a/src/ghdldrv/ghdllocal.adb +++ b/src/ghdldrv/ghdllocal.adb @@ -20,6 +20,7 @@ with Ada.Command_Line; with GNAT.Directory_Operations; with Types; use Types; with Libraries; +with Sem_Lib; with Std_Package; with Flags; with Name_Table; @@ -632,7 +633,7 @@ package body Ghdllocal is for I in Args'Range loop Id := Get_Identifier (Args (I).all); - Design_File := Libraries.Load_File (Id); + Design_File := Sem_Lib.Load_File (Id); if Design_File /= Null_Iir then Unit := Get_First_Design_Unit (Design_File); while Unit /= Null_Iir loop @@ -693,7 +694,7 @@ package body Ghdllocal is -- Parse all files. for I in Args'Range loop Id := Name_Table.Get_Identifier (Args (I).all); - Design_File := Libraries.Load_File (Id); + Design_File := Sem_Lib.Load_File (Id); if Design_File /= Null_Iir then Unit := Get_First_Design_Unit (Design_File); while Unit /= Null_Iir loop @@ -728,7 +729,7 @@ package body Ghdllocal is | Date_Analyzed => null; when Date_Parsed => - Libraries.Finish_Compilation (Unit, False); + Sem_Lib.Finish_Compilation (Unit, False); when others => raise Internal_Error; end case; @@ -780,7 +781,7 @@ package body Ghdllocal is Put (File_Name); Put_Line (":"); end if; - Design_File := Libraries.Load_File (Id); + Design_File := Sem_Lib.Load_File (Id); if Design_File = Null_Iir then raise Errorout.Compilation_Error; end if; @@ -793,7 +794,7 @@ package body Ghdllocal is New_Line; end if; -- Sem, canon, annotate a design unit. - Libraries.Finish_Compilation (Unit, True); + Sem_Lib.Finish_Compilation (Unit, True); Next_Unit := Get_Chain (Unit); if Errorout.Nbr_Errors = 0 then @@ -1224,14 +1225,14 @@ package body Ghdllocal is -- date. Unit := Get_First_Design_Unit (File); while Unit /= Null_Iir loop - Load_Parse_Design_Unit (Unit, Null_Iir); + Sem_Lib.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); + Design_File := Sem_Lib.Load_File (Fe); -- Exit now in case of parse error. if Design_File = Null_Iir @@ -1349,7 +1350,7 @@ package body Ghdllocal is Get_File_Checksum (File)) then -- FILE has been modified. - Design_File := Libraries.Load_File (Fe); + Design_File := Sem_Lib.Load_File (Fe); if Design_File /= Null_Iir then Libraries.Add_Design_File_Into_Library (Design_File); end if; diff --git a/src/ghdldrv/ghdlprint.adb b/src/ghdldrv/ghdlprint.adb index 531d6125a..04e7bd207 100644 --- a/src/ghdldrv/ghdlprint.adb +++ b/src/ghdldrv/ghdlprint.adb @@ -33,6 +33,7 @@ with Parse; with Canon; with Version; with Xrefs; +with Sem_Lib; use Sem_Lib; with Ghdlmain; use Ghdlmain; with Ghdllocal; use Ghdllocal; with Disp_Vhdl; @@ -677,7 +678,7 @@ package body Ghdlprint is -- exist. for I in Args'Range loop Id := Get_Identifier (Args (I).all); - Design_File := Libraries.Load_File (Id); + Design_File := Load_File (Id); if Design_File = Null_Iir then raise Compile_Error; end if; @@ -707,7 +708,7 @@ package body Ghdlprint is -- Second loop: do the real work. for I in Args'Range loop Id := Get_Identifier (Args (I).all); - Design_File := Libraries.Load_File (Id); + Design_File := Load_File (Id); Unit := Get_First_Design_Unit (Design_File); declare use Files_Map; @@ -991,7 +992,7 @@ package body Ghdlprint is -- Parse all files. for I in Args'Range loop Id := Name_Table.Get_Identifier (Args (I).all); - Design_File := Libraries.Load_File (Id); + Design_File := Load_File (Id); if Design_File = Null_Iir then raise Errorout.Compilation_Error; end if; @@ -999,7 +1000,7 @@ package body Ghdlprint is Unit := Get_First_Design_Unit (Design_File); while Unit /= Null_Iir loop -- Analyze the design unit. - Libraries.Finish_Compilation (Unit, True); + Sem_Lib.Finish_Compilation (Unit, True); Next_Unit := Get_Chain (Unit); if Errorout.Nbr_Errors = 0 then @@ -1280,7 +1281,7 @@ package body Ghdlprint is | Date_Disk => raise Internal_Error; when Date_Parse => - Libraries.Load_Design_Unit (Unit, Null_Iir); + Sem_Lib.Load_Design_Unit (Unit, Null_Iir); when Date_Analyze => null; end case; @@ -1340,7 +1341,7 @@ package body Ghdlprint is return; end if; Files (I).Fe := File; - Files (I).Design_File := Libraries.Load_File (File); + Files (I).Design_File := Load_File (File); if Files (I).Design_File = Null_Iir then return; end if; @@ -1573,7 +1574,7 @@ package body Ghdlprint is return; end if; Files (I).Fe := File; - Files (I).Design_File := Libraries.Load_File (File); + Files (I).Design_File := Load_File (File); if Files (I).Design_File = Null_Iir then return; end if; diff --git a/src/ghdldrv/ghdlxml.adb b/src/ghdldrv/ghdlxml.adb index 49a997670..a37e6dbe1 100644 --- a/src/ghdldrv/ghdlxml.adb +++ b/src/ghdldrv/ghdlxml.adb @@ -26,6 +26,7 @@ with Ghdlprint; use Ghdlprint; with Libraries; with Errorout; use Errorout; with Iirs; use Iirs; +with Sem_Lib; use Sem_Lib; with Ghdlmain; use Ghdlmain; with Ghdllocal; use Ghdllocal; @@ -561,7 +562,7 @@ package body Ghdlxml is return; end if; Files (I).Fe := File; - Files (I).Design_File := Libraries.Load_File (File); + Files (I).Design_File := Load_File (File); if Files (I).Design_File = Null_Iir then return; end if; diff --git a/src/libraries.adb b/src/libraries.adb index 61f603b66..3ae9f7e25 100644 --- a/src/libraries.adb +++ b/src/libraries.adb @@ -23,19 +23,12 @@ with System; with Errorout; use Errorout; with Scanner; with Iirs_Utils; use Iirs_Utils; -with Parse; with Name_Table; use Name_Table; with Str_Table; with Tokens; with Files_Map; with Flags; with Std_Package; -with Disp_Tree; -with Disp_Vhdl; -with Sem; -with Post_Sems; -with Canon; -with Nodes_GC; package body Libraries is -- Chain of known libraries. This is also the top node of all iir node. @@ -55,11 +48,6 @@ package body Libraries is Report_Msg (Msgid_Error, Library, No_Location, Msg); end Error_Lib_Msg; - procedure Error_Lib_Msg (Msg : String; Arg1 : Earg_Type) is - begin - Report_Msg (Msgid_Error, Library, No_Location, Msg, (1 => Arg1)); - end Error_Lib_Msg; - -- Initialize paths table. -- Set the local path. procedure Init_Paths is @@ -888,76 +876,6 @@ package body Libraries is return Null_Iir; end Find_Design_File; - procedure Error_Obsolete (Loc : Iir; Msg : String; Args : Earg_Arr) is - begin - if not Flags.Flag_Elaborate_With_Outdated then - if Loc = Null_Iir then - Error_Msg_Sem (Command_Line_Location, Msg, Args); - else - Error_Msg_Sem (+Loc, Msg, Args); - end if; - end if; - end Error_Obsolete; - - -- Check if one of its dependency makes this unit obsolete. - function Check_Obsolete_Dependence (Design_Unit : Iir; Loc : Iir) - return Boolean - is - List : constant Iir_List := Get_Dependence_List (Design_Unit); - Du_Ts : constant Time_Stamp_Id := - Get_Analysis_Time_Stamp (Get_Design_File (Design_Unit)); - U_Ts : Time_Stamp_Id; - El : Iir; - It : List_Iterator; - begin - if List = Null_Iir_List then - return False; - end if; - - It := List_Iterate (List); - while Is_Valid (It) loop - El := Get_Element (It); - if Get_Kind (El) = Iir_Kind_Design_Unit then - U_Ts := Get_Analysis_Time_Stamp (Get_Design_File (El)); - if Files_Map.Is_Gt (U_Ts, Du_Ts) then - Error_Obsolete - (Loc, "%n is obsoleted by %n", (+Design_Unit, +El)); - return True; - end if; - end if; - Next (It); - end loop; - - return False; - end Check_Obsolete_Dependence; - - procedure Explain_Obsolete (Design_Unit : Iir_Design_Unit; Loc : Iir) - is - List : Iir_List; - It : List_Iterator; - El : Iir; - begin - pragma Assert (Get_Date_State (Design_Unit) = Date_Analyze); - pragma Assert (Get_Date (Design_Unit) = Date_Obsolete); - - List := Get_Dependence_List (Design_Unit); - if List = Null_Iir_List then - -- Argh, we don't know why. - Error_Obsolete (Loc, "%n is obsolete", (1 => +Design_Unit)); - return; - end if; - - It := List_Iterate (List); - while Is_Valid (It) loop - El := Get_Element (It); - if Get_Date (El) = Date_Obsolete then - Error_Obsolete (Loc, "%n is obsoleted by %n", (+Design_Unit, +El)); - return; - end if; - Next (It); - end loop; - end Explain_Obsolete; - -- Mark UNIT as obsolete. Mark all units that depends on UNIT as -- obsolete. procedure Mark_Unit_Obsolete (Unit : Iir_Design_Unit) @@ -1009,17 +927,6 @@ package body Libraries is end loop; end Mark_Unit_Obsolete; - procedure Free_Dependence_List (Design : Iir_Design_Unit) - is - List : Iir_List; - begin - List := Get_Dependence_List (Design); - if List /= Null_Iir_List then - Free_Recursive_List (List); - Destroy_Iir_List (List); - end if; - end Free_Dependence_List; - -- This procedure is called when the DESIGN_UNIT (either the stub created -- when a library is read or created from a previous unit in a source -- file) has been replaced by a new unit. Free everything but DESIGN_UNIT, @@ -1593,265 +1500,6 @@ package body Libraries is end if; end Get_Latest_Architecture; - function Load_File (File : Source_File_Entry) return Iir_Design_File - is - Res : Iir_Design_File; - begin - Scanner.Set_File (File); - if Scanner.Detect_Encoding_Errors then - -- Don't even try to parse such a file. The BOM will be interpreted - -- as an identifier, which is not valid at the beginning of a file. - Res := Null_Iir; - else - Res := Parse.Parse_Design_File; - end if; - Scanner.Close_File; - - if Res /= Null_Iir then - Set_Parent (Res, Work_Library); - Set_Design_File_Filename (Res, Files_Map.Get_File_Name (File)); - end if; - return Res; - end Load_File; - - -- parse a file. - -- Return a design_file without putting it into the library - -- (because it was not analyzed). - function Load_File (File_Name: Name_Id) return Iir_Design_File - is - Fe : Source_File_Entry; - begin - Fe := Files_Map.Read_Source_File (Local_Directory, File_Name); - if Fe = No_Source_File_Entry then - Error_Msg_Option ("cannot open " & Image (File_Name)); - return Null_Iir; - end if; - return Load_File (Fe); - end Load_File; - - procedure Finish_Compilation - (Unit : Iir_Design_Unit; Main : Boolean := False) - is - Lib_Unit : Iir; - begin - Lib_Unit := Get_Library_Unit (Unit); - if (Main or Flags.Dump_All) and then Flags.Dump_Parse then - Disp_Tree.Disp_Tree (Unit); - end if; - - if Flags.Check_Ast_Level > 0 then - Nodes_GC.Check_Tree (Unit); - end if; - - if Flags.Verbose then - Report_Msg (Msgid_Note, Semantic, +Lib_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; - - if Flags.Check_Ast_Level > 0 then - Nodes_GC.Check_Tree (Unit); - end if; - - -- Post checks - ---------------- - - Post_Sems.Post_Sem_Checks (Unit); - - if Errorout.Nbr_Errors > 0 then - raise Compilation_Error; - end if; - - -- Canonalisation. - ------------------ - - if Flags.Verbose then - Report_Msg (Msgid_Note, Semantic, +Lib_Unit, - "canonicalize %n", (1 => +Lib_Unit)); - end if; - - Canon.Canonicalize (Unit); - - if (Main or Flags.Dump_All) and then Flags.Dump_Canon 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_Canon then - Disp_Vhdl.Disp_Vhdl (Unit); - end if; - - if Flags.Check_Ast_Level > 0 then - Nodes_GC.Check_Tree (Unit); - end if; - end Finish_Compilation; - - procedure Load_Parse_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir) - is - use Scanner; - Line, Off: Natural; - Pos: Source_Ptr; - Res: Iir; - Design_File : Iir_Design_File; - Fe : Source_File_Entry; - begin - -- The unit must not be loaded. - pragma Assert (Get_Date_State (Design_Unit) = Date_Disk); - - -- Load the file in memory. - Design_File := Get_Design_File (Design_Unit); - Fe := Files_Map.Read_Source_File - (Get_Design_File_Directory (Design_File), - Get_Design_File_Filename (Design_File)); - if Fe = No_Source_File_Entry then - Error_Lib_Msg ("cannot load %n", +Get_Library_Unit (Design_Unit)); - raise Compilation_Error; - end if; - Set_File (Fe); - - -- Check if the file has changed. - if not Files_Map.Is_Eq - (Files_Map.Get_File_Checksum (Get_Current_Source_File), - Get_File_Checksum (Design_File)) - then - Error_Msg_Sem (+Loc, "file %i has changed and must be reanalysed", - +Get_Design_File_Filename (Design_File)); - raise Compilation_Error; - elsif Get_Date (Design_Unit) = Date_Obsolete then - Error_Msg_Sem (+Design_Unit, "%n has been obsoleted", - +Get_Library_Unit (Design_Unit)); - raise Compilation_Error; - end if; - - -- Set the position of the lexer - Pos := Get_Design_Unit_Source_Pos (Design_Unit); - Line := Natural (Get_Design_Unit_Source_Line (Design_Unit)); - Off := Natural (Get_Design_Unit_Source_Col (Design_Unit)); - Files_Map.File_Add_Line_Number (Get_Current_Source_File, Line, Pos); - Set_Current_Position (Pos + Source_Ptr (Off)); - - -- Parse - Res := Parse.Parse_Design_Unit; - Close_File; - if Res = Null_Iir then - raise Compilation_Error; - end if; - - Set_Date_State (Design_Unit, Date_Parse); - - -- FIXME: check the library unit read is the one expected. - - -- Move the unit in the library: keep the design_unit of the library, - -- but replace the library_unit by the one that has been parsed. Do - -- not forget to relocate parents. - Iirs_Utils.Free_Recursive (Get_Library_Unit (Design_Unit)); - Set_Library_Unit (Design_Unit, Get_Library_Unit (Res)); - Set_Design_Unit (Get_Library_Unit (Res), Design_Unit); - Set_Parent (Get_Library_Unit (Res), Design_Unit); - declare - Item : Iir; - begin - Item := Get_Context_Items (Res); - Set_Context_Items (Design_Unit, Item); - while Is_Valid (Item) loop - Set_Parent (Item, Design_Unit); - Item := Get_Chain (Item); - end loop; - end; - Location_Copy (Design_Unit, Res); - Free_Dependence_List (Design_Unit); - Set_Dependence_List (Design_Unit, Get_Dependence_List (Res)); - Set_Dependence_List (Res, Null_Iir_List); - Free_Iir (Res); - end Load_Parse_Design_Unit; - - -- Load, parse, analyze, back-end a design_unit if necessary. - procedure Load_Design_Unit (Design_Unit : Iir_Design_Unit; Loc : Iir) - is - Warnings : Warnings_Setting; - begin - if Get_Date (Design_Unit) = Date_Replacing then - Error_Msg_Sem (+Loc, "circular reference of %n", +Design_Unit); - return; - end if; - - if Get_Date_State (Design_Unit) = Date_Disk then - Load_Parse_Design_Unit (Design_Unit, Loc); - end if; - - if Get_Date_State (Design_Unit) = Date_Parse then - -- Analyze the design unit. - - if Get_Date (Design_Unit) = Date_Analyzed then - -- Work-around for an internal check in sem. - -- FIXME: to be removed ? - Set_Date (Design_Unit, Date_Parsed); - end if; - - -- Avoid infinite recursion, if the unit is self-referenced. - Set_Date_State (Design_Unit, Date_Analyze); - - -- Disable all warnings. Warnings are emitted only when the unit - -- is analyzed. - Save_Warnings_Setting (Warnings); - Disable_All_Warnings; - - -- Analyze unit. - Finish_Compilation (Design_Unit); - - -- Restore warnings. - Restore_Warnings_Setting (Warnings); - - -- Check if one of its dependency makes this unit obsolete. - -- FIXME: to do when the dependency is added ? - if not Flags.Flag_Elaborate_With_Outdated - and then Check_Obsolete_Dependence (Design_Unit, Loc) - then - Set_Date (Design_Unit, Date_Obsolete); - return; - end if; - end if; - - case Get_Date (Design_Unit) is - when Date_Parsed => - raise Internal_Error; - when Date_Analyzing => - -- Self-referenced unit. - return; - when Date_Analyzed => - -- FIXME: Accept it silently ? - -- Note: this is used when Flag_Elaborate_With_Outdated is set. - -- This is also used by anonymous configuration declaration. - null; - when Date_Uptodate => - return; - when Date_Valid => - null; - when Date_Obsolete => - if not Flags.Flag_Elaborate_With_Outdated then - Explain_Obsolete (Design_Unit, Loc); - end if; - when others => - raise Internal_Error; - end case; - end Load_Design_Unit; - -- Return the declaration of primary unit NAME of LIBRARY. function Find_Primary_Unit (Library: Iir_Library_Declaration; Name: Name_Id) @@ -1879,19 +1527,6 @@ package body Libraries is return Null_Iir; end Find_Primary_Unit; - function Load_Primary_Unit - (Library: Iir_Library_Declaration; Name: Name_Id; Loc : Iir) - return Iir_Design_Unit - is - Design_Unit: Iir_Design_Unit; - begin - Design_Unit := Find_Primary_Unit (Library, Name); - if Design_Unit /= Null_Iir then - Load_Design_Unit (Design_Unit, Loc); - end if; - return Design_Unit; - end Load_Primary_Unit; - -- Return the declaration of secondary unit NAME for PRIMARY, or null if -- not found. function Find_Secondary_Unit (Primary: Iir_Design_Unit; Name: Name_Id) @@ -1939,20 +1574,6 @@ package body Libraries is return Null_Iir; end Find_Secondary_Unit; - -- Load an secondary unit and analyse it. - function Load_Secondary_Unit - (Primary: Iir_Design_Unit; Name: Name_Id; Loc : Iir) - return Iir_Design_Unit - is - Design_Unit: Iir_Design_Unit; - begin - Design_Unit := Find_Secondary_Unit (Primary, Name); - if Design_Unit /= Null_Iir then - Load_Design_Unit (Design_Unit, Loc); - end if; - return Design_Unit; - end Load_Secondary_Unit; - function Find_Entity_For_Component (Name: Name_Id) return Iir_Design_Unit is Res : Iir_Design_Unit := Null_Iir; diff --git a/src/libraries.ads b/src/libraries.ads index e8060c522..df2843d7a 100644 --- a/src/libraries.ads +++ b/src/libraries.ads @@ -99,25 +99,6 @@ package Libraries is -- Save the work library as a host-dependent library. procedure Save_Work_Library; - -- Start the analyse a file (ie load and parse it). - -- The file is read from the current directory (unless FILE_NAME is an - -- absolute path). - -- Emit an error if the file cannot be opened. - -- Return NULL_IIR in case of parse error. - function Load_File (File_Name: Name_Id) return Iir_Design_File; - function Load_File (File : Source_File_Entry) return Iir_Design_File; - - -- Load, parse, analyze, back-end a design_unit if necessary. - -- Check Design_Unit is not obsolete. - -- LOC is the location where the design unit was needed, in case of error. - procedure Load_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir); - - -- Load and parse DESIGN_UNIT. - -- Contrary to Load_Design_Unit, the design_unit is not analyzed. - -- Also, the design_unit must not have been already loaded. - -- Used almost only by Load_Design_Unit. - procedure Load_Parse_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir); - -- Remove the same file as DESIGN_FILE from work library and all of its -- units. procedure Purge_Design_File (Design_File : Iir_Design_File); @@ -127,31 +108,6 @@ package Libraries is (Library: Iir_Library_Declaration; Name: Name_Id) return Iir_Design_Unit; - -- Load an already analyzed primary unit NAME from library LIBRARY - -- and compile it. - -- Return NULL_IIR if not found (ie, NAME does not correspond to a - -- library unit identifier). - function Load_Primary_Unit - (Library: Iir_Library_Declaration; Name: Name_Id; Loc : Iir) - return Iir_Design_Unit; - - -- Find the secondary unit of PRIMARY. - -- If PRIMARY is a package declaration, returns the package body, - -- If PRIMARY is an entity declaration, returns the architecture NAME. - -- Return NULL_IIR if not found. - function Find_Secondary_Unit (Primary: Iir_Design_Unit; Name: Name_Id) - return Iir_Design_Unit; - - -- Load an secondary unit of primary unit PRIMARY and analyse it. - -- NAME must be set only for an architecture. - function Load_Secondary_Unit - (Primary: Iir_Design_Unit; Name: Name_Id; Loc : Iir) - return Iir_Design_Unit; - - -- Analyze UNIT. - procedure Finish_Compilation - (Unit : Iir_Design_Unit; Main : Boolean := False); - -- Get or create a library from an identifier. -- LOC is used only to report errors. function Get_Library (Ident : Name_Id; Loc : Location_Type) @@ -190,6 +146,13 @@ package Libraries is -- Return null_iir if the design unit is not found. function Find_Design_Unit (Unit : Iir) return Iir_Design_Unit; + -- Find the secondary unit of PRIMARY. + -- If PRIMARY is a package declaration, returns the package body, + -- If PRIMARY is an entity declaration, returns the architecture NAME. + -- Return NULL_IIR if not found. + function Find_Secondary_Unit (Primary: Iir_Design_Unit; Name: Name_Id) + return Iir_Design_Unit; + -- Search design file NAME in library LIB. This is not very efficient as -- this is a simple linear search. NAME must correspond exactely to the -- design file name. diff --git a/src/vhdl/configuration.adb b/src/vhdl/configuration.adb index 6216311b9..57b09f455 100644 --- a/src/vhdl/configuration.adb +++ b/src/vhdl/configuration.adb @@ -24,6 +24,7 @@ with Flags; with Iirs_Utils; use Iirs_Utils; with Iirs_Walk; with Sem_Scopes; +with Sem_Lib; use Sem_Lib; with Canon; package body Configuration is @@ -103,7 +104,7 @@ package body Configuration is end if; if Flag_Load_All_Design_Units then - Libraries.Load_Design_Unit (Unit, From); + Load_Design_Unit (Unit, From); end if; -- Add packages from depend list. @@ -140,7 +141,7 @@ package body Configuration is when Iir_Kind_Package_Declaration => -- Analyze the package declaration, so that Set_Package below -- will set the full package (and not a stub). - Libraries.Load_Design_Unit (Unit, From); + Load_Design_Unit (Unit, From); Lib_Unit := Get_Library_Unit (Unit); when Iir_Kind_Package_Instantiation_Declaration => -- The uninstantiated package is part of the dependency. @@ -148,7 +149,7 @@ package body Configuration is when Iir_Kind_Configuration_Declaration => -- Add entity and architecture. -- find all sub-configuration - Libraries.Load_Design_Unit (Unit, From); + Load_Design_Unit (Unit, From); Lib_Unit := Get_Library_Unit (Unit); Add_Design_Unit (Get_Design_Unit (Get_Entity (Lib_Unit)), Unit); declare @@ -788,9 +789,9 @@ package body Configuration is case Iir_Kinds_Library_Unit (Kind) is when Iir_Kind_Architecture_Body | Iir_Kind_Configuration_Declaration => - Libraries.Load_Design_Unit (Design, Null_Iir); + Load_Design_Unit (Design, Null_Iir); when Iir_Kind_Entity_Declaration => - Libraries.Load_Design_Unit (Design, Null_Iir); + Load_Design_Unit (Design, Null_Iir); Sem_Scopes.Add_Name (Get_Library_Unit (Design)); when Iir_Kind_Package_Declaration | Iir_Kind_Package_Instantiation_Declaration diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb index ecb90a517..046e52b09 100644 --- a/src/vhdl/iirs_utils.adb +++ b/src/vhdl/iirs_utils.adb @@ -24,7 +24,6 @@ with Std_Names; use Std_Names; with Std_Package; with Flags; use Flags; with PSL.Nodes; -with Sem_Inst; package body Iirs_Utils is -- Transform the current token into an iir literal. @@ -937,20 +936,6 @@ package body Iirs_Utils is return Iir_Predefined_Functions'Image (Func); end Get_Predefined_Function_Name; - procedure Mark_Subprogram_Used (Subprg : Iir) - is - N : Iir; - begin - N := Subprg; - loop - exit when Get_Use_Flag (N); - Set_Use_Flag (N, True); - N := Sem_Inst.Get_Origin (N); - -- The origin may also be an instance. - exit when N = Null_Iir; - end loop; - end Mark_Subprogram_Used; - function Get_Callees_List_Holder (Subprg : Iir) return Iir is begin case Get_Kind (Subprg) is diff --git a/src/vhdl/iirs_utils.ads b/src/vhdl/iirs_utils.ads index 1aabea149..ad1a58f84 100644 --- a/src/vhdl/iirs_utils.ads +++ b/src/vhdl/iirs_utils.ads @@ -144,10 +144,6 @@ package Iirs_Utils is function Get_Predefined_Function_Name (Func : Iir_Predefined_Functions) return String; - -- Mark SUBPRG as used. If SUBPRG is an instance, its generic is also - -- marked. - procedure Mark_Subprogram_Used (Subprg : Iir); - -- Create the range_constraint node for an enumeration type. procedure Create_Range_Constraint_For_Enumeration_Type (Def : Iir_Enumeration_Type_Definition); diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb index 83308a74c..7408d05e7 100644 --- a/src/vhdl/sem.adb +++ b/src/vhdl/sem.adb @@ -15,7 +15,6 @@ -- along with GHDL; see the file COPYING. If not, write to the Free -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. -with Ada.Unchecked_Conversion; with Errorout; use Errorout; with Std_Package; use Std_Package; with Ieee.Std_Logic_1164; @@ -28,6 +27,7 @@ with Sem_Specs; use Sem_Specs; with Sem_Decls; use Sem_Decls; with Sem_Assocs; use Sem_Assocs; with Sem_Inst; +with Sem_Lib; use Sem_Lib; with Iirs_Utils; use Iirs_Utils; with Flags; use Flags; with Str_Table; @@ -110,7 +110,7 @@ package body Sem is -- architecture body is in the declarative region of its entity, -- the entity name is directly visible. But we cannot really use -- that rule as is, as we don't know which is the entity. - Entity := Libraries.Load_Primary_Unit + Entity := Load_Primary_Unit (Library, Get_Identifier (Name), Library_Unit); if Entity = Null_Iir then Error_Msg_Sem (+Library_Unit, "entity %n was not analysed", +Name); @@ -930,7 +930,7 @@ package body Sem is -- declaration: at the place of the block specification in a -- block configuration for an external block whose interface -- is defined by that entity declaration. - Design := Libraries.Load_Secondary_Unit + Design := Load_Secondary_Unit (Get_Design_Unit (Get_Entity (Father)), Get_Identifier (Block_Spec), Block_Conf); @@ -995,10 +995,9 @@ package body Sem is return; end if; - Design := Libraries.Load_Secondary_Unit - (Get_Design_Unit (Entity), - Get_Identifier (Block_Spec), - Block_Conf); + Design := Load_Secondary_Unit (Get_Design_Unit (Entity), + Get_Identifier (Block_Spec), + Block_Conf); if Design = Null_Iir then Error_Msg_Sem (+Block_Conf, "no architecture %i", +Block_Spec); @@ -2704,7 +2703,7 @@ package body Sem is declare Design_Unit: Iir_Design_Unit; begin - Design_Unit := Libraries.Load_Primary_Unit + Design_Unit := Load_Primary_Unit (Get_Library (Get_Design_File (Get_Current_Design_Unit)), Package_Ident, Decl); if Design_Unit = Null_Iir then @@ -2840,7 +2839,7 @@ package body Sem is if Get_Need_Body (Pkg) and then not Is_Nested_Package (Pkg) then Bod := Get_Package_Body (Pkg); if Is_Null (Bod) then - Bod := Libraries.Load_Secondary_Unit + Bod := Load_Secondary_Unit (Get_Design_Unit (Pkg), Null_Identifier, Decl); else Bod := Get_Design_Unit (Bod); diff --git a/src/vhdl/sem_assocs.adb b/src/vhdl/sem_assocs.adb index 299242a2f..098d21e20 100644 --- a/src/vhdl/sem_assocs.adb +++ b/src/vhdl/sem_assocs.adb @@ -24,6 +24,7 @@ with Parse; with Std_Names; with Sem_Names; use Sem_Names; with Sem_Types; +with Sem_Decls; with Std_Package; with Sem_Scopes; with Iir_Chains; use Iir_Chains; @@ -1776,7 +1777,7 @@ package body Sem_Assocs is Set_Named_Entity (Actual, Res); Xrefs.Xref_Name (Actual); - Mark_Subprogram_Used (Res); + Sem_Decls.Mark_Subprogram_Used (Res); end Sem_Association_Subprogram; -- Associate ASSOC with interface INTERFACE diff --git a/src/vhdl/sem_decls.adb b/src/vhdl/sem_decls.adb index 408ee21fd..d26b880eb 100644 --- a/src/vhdl/sem_decls.adb +++ b/src/vhdl/sem_decls.adb @@ -21,8 +21,6 @@ with Std_Names; with Tokens; with Flags; use Flags; with Std_Package; use Std_Package; -with Ieee.Std_Logic_1164; -with Iir_Chains; with Evaluation; use Evaluation; with Iirs_Utils; use Iirs_Utils; with Sem; use Sem; @@ -35,7 +33,6 @@ with Sem_Types; use Sem_Types; with Sem_Psl; with Sem_Inst; with Xrefs; use Xrefs; -use Iir_Chains; package body Sem_Decls is -- Region that can declare signals. Used to add implicit declarations. @@ -145,6 +142,20 @@ package body Sem_Decls is end if; end End_Of_Declarations_For_Implicit_Declarations; + procedure Mark_Subprogram_Used (Subprg : Iir) + is + N : Iir; + begin + N := Subprg; + loop + exit when Get_Use_Flag (N); + Set_Use_Flag (N, True); + N := Sem_Inst.Get_Origin (N); + -- The origin may also be an instance. + exit when N = Null_Iir; + end loop; + end Mark_Subprogram_Used; + -- Emit an error if the type of DECL is a file type, access type, -- protected type or if a subelement of DECL is an access type. procedure Check_Signal_Type (Decl : Iir) diff --git a/src/vhdl/sem_decls.ads b/src/vhdl/sem_decls.ads index b6ab949ec..4362a34fd 100644 --- a/src/vhdl/sem_decls.ads +++ b/src/vhdl/sem_decls.ads @@ -52,6 +52,10 @@ package Sem_Decls is -- discrete ranges. procedure Sem_Object_Type_From_Value (Decl : Iir; Value : Iir); + -- Mark SUBPRG as used. If SUBPRG is an instance, its generic is also + -- marked. + procedure Mark_Subprogram_Used (Subprg : Iir); + -- The attribute signals ('stable, 'quiet and 'transaction) are -- implicitely declared. -- Note: guard signals are also implicitly declared but with a guard diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb index e08fc5940..c75a78823 100644 --- a/src/vhdl/sem_expr.adb +++ b/src/vhdl/sem_expr.adb @@ -31,6 +31,7 @@ with Iir_Chains; use Iir_Chains; with Sem_Types; with Sem_Stmts; use Sem_Stmts; with Sem_Assocs; use Sem_Assocs; +with Sem_Decls; with Xrefs; use Xrefs; package body Sem_Expr is @@ -1173,7 +1174,7 @@ package body Sem_Expr is Subprg : constant Iir := Get_Current_Subprogram; begin Set_Function_Call_Staticness (Expr, Imp); - Mark_Subprogram_Used (Imp); + Sem_Decls.Mark_Subprogram_Used (Imp); -- Check purity/wait/passive. diff --git a/src/vhdl/sem_inst.adb b/src/vhdl/sem_inst.adb index c32ccebf9..b4673efeb 100644 --- a/src/vhdl/sem_inst.adb +++ b/src/vhdl/sem_inst.adb @@ -21,7 +21,6 @@ with Types; use Types; with Files_Map; with Iirs_Utils; use Iirs_Utils; with Errorout; use Errorout; -with Sem; with Sem_Utils; package body Sem_Inst is diff --git a/src/vhdl/sem_lib.adb b/src/vhdl/sem_lib.adb new file mode 100644 index 000000000..cf32ea7f1 --- /dev/null +++ b/src/vhdl/sem_lib.adb @@ -0,0 +1,388 @@ +with Flags; +with Name_Table; +with Files_Map; +with Iirs_Utils; use Iirs_Utils; +with Errorout; use Errorout; +with Libraries; use Libraries; +with Scanner; +with Parse; +with Disp_Tree; +with Disp_Vhdl; +with Sem; +with Post_Sems; +with Canon; +with Nodes_GC; + +package body Sem_Lib is + procedure Error_Lib_Msg (Msg : String; Arg1 : Earg_Type) is + begin + Report_Msg (Msgid_Error, Library, No_Location, Msg, (1 => Arg1)); + end Error_Lib_Msg; + + function Load_File (File : Source_File_Entry) return Iir_Design_File + is + Res : Iir_Design_File; + begin + Scanner.Set_File (File); + if Scanner.Detect_Encoding_Errors then + -- Don't even try to parse such a file. The BOM will be interpreted + -- as an identifier, which is not valid at the beginning of a file. + Res := Null_Iir; + else + Res := Parse.Parse_Design_File; + end if; + Scanner.Close_File; + + if Res /= Null_Iir then + Set_Parent (Res, Work_Library); + Set_Design_File_Filename (Res, Files_Map.Get_File_Name (File)); + end if; + return Res; + end Load_File; + + -- parse a file. + -- Return a design_file without putting it into the library + -- (because it was not analyzed). + function Load_File (File_Name: Name_Id) return Iir_Design_File + is + Fe : Source_File_Entry; + begin + Fe := Files_Map.Read_Source_File (Local_Directory, File_Name); + if Fe = No_Source_File_Entry then + Error_Msg_Option ("cannot open " & Name_Table.Image (File_Name)); + return Null_Iir; + end if; + return Load_File (Fe); + end Load_File; + + procedure Finish_Compilation + (Unit : Iir_Design_Unit; Main : Boolean := False) + is + Lib_Unit : Iir; + begin + Lib_Unit := Get_Library_Unit (Unit); + if (Main or Flags.Dump_All) and then Flags.Dump_Parse then + Disp_Tree.Disp_Tree (Unit); + end if; + + if Flags.Check_Ast_Level > 0 then + Nodes_GC.Check_Tree (Unit); + end if; + + if Flags.Verbose then + Report_Msg (Msgid_Note, Semantic, +Lib_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; + + if Flags.Check_Ast_Level > 0 then + Nodes_GC.Check_Tree (Unit); + end if; + + -- Post checks + ---------------- + + Post_Sems.Post_Sem_Checks (Unit); + + if Errorout.Nbr_Errors > 0 then + raise Compilation_Error; + end if; + + -- Canonalisation. + ------------------ + + if Flags.Verbose then + Report_Msg (Msgid_Note, Semantic, +Lib_Unit, + "canonicalize %n", (1 => +Lib_Unit)); + end if; + + Canon.Canonicalize (Unit); + + if (Main or Flags.Dump_All) and then Flags.Dump_Canon 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_Canon then + Disp_Vhdl.Disp_Vhdl (Unit); + end if; + + if Flags.Check_Ast_Level > 0 then + Nodes_GC.Check_Tree (Unit); + end if; + end Finish_Compilation; + + procedure Free_Dependence_List (Design : Iir_Design_Unit) + is + List : Iir_List; + begin + List := Get_Dependence_List (Design); + if List /= Null_Iir_List then + Free_Recursive_List (List); + Destroy_Iir_List (List); + end if; + end Free_Dependence_List; + + procedure Load_Parse_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir) + is + use Scanner; + Line, Off: Natural; + Pos: Source_Ptr; + Res: Iir; + Design_File : Iir_Design_File; + Fe : Source_File_Entry; + begin + -- The unit must not be loaded. + pragma Assert (Get_Date_State (Design_Unit) = Date_Disk); + + -- Load the file in memory. + Design_File := Get_Design_File (Design_Unit); + Fe := Files_Map.Read_Source_File + (Get_Design_File_Directory (Design_File), + Get_Design_File_Filename (Design_File)); + if Fe = No_Source_File_Entry then + Error_Lib_Msg ("cannot load %n", +Get_Library_Unit (Design_Unit)); + raise Compilation_Error; + end if; + Set_File (Fe); + + -- Check if the file has changed. + if not Files_Map.Is_Eq + (Files_Map.Get_File_Checksum (Get_Current_Source_File), + Get_File_Checksum (Design_File)) + then + Error_Msg_Sem (+Loc, "file %i has changed and must be reanalysed", + +Get_Design_File_Filename (Design_File)); + raise Compilation_Error; + elsif Get_Date (Design_Unit) = Date_Obsolete then + Error_Msg_Sem (+Design_Unit, "%n has been obsoleted", + +Get_Library_Unit (Design_Unit)); + raise Compilation_Error; + end if; + + -- Set the position of the lexer + Pos := Get_Design_Unit_Source_Pos (Design_Unit); + Line := Natural (Get_Design_Unit_Source_Line (Design_Unit)); + Off := Natural (Get_Design_Unit_Source_Col (Design_Unit)); + Files_Map.File_Add_Line_Number (Get_Current_Source_File, Line, Pos); + Set_Current_Position (Pos + Source_Ptr (Off)); + + -- Parse + Res := Parse.Parse_Design_Unit; + Close_File; + if Res = Null_Iir then + raise Compilation_Error; + end if; + + Set_Date_State (Design_Unit, Date_Parse); + + -- FIXME: check the library unit read is the one expected. + + -- Move the unit in the library: keep the design_unit of the library, + -- but replace the library_unit by the one that has been parsed. Do + -- not forget to relocate parents. + Iirs_Utils.Free_Recursive (Get_Library_Unit (Design_Unit)); + Set_Library_Unit (Design_Unit, Get_Library_Unit (Res)); + Set_Design_Unit (Get_Library_Unit (Res), Design_Unit); + Set_Parent (Get_Library_Unit (Res), Design_Unit); + declare + Item : Iir; + begin + Item := Get_Context_Items (Res); + Set_Context_Items (Design_Unit, Item); + while Is_Valid (Item) loop + Set_Parent (Item, Design_Unit); + Item := Get_Chain (Item); + end loop; + end; + Location_Copy (Design_Unit, Res); + Free_Dependence_List (Design_Unit); + Set_Dependence_List (Design_Unit, Get_Dependence_List (Res)); + Set_Dependence_List (Res, Null_Iir_List); + Free_Iir (Res); + end Load_Parse_Design_Unit; + + procedure Error_Obsolete (Loc : Iir; Msg : String; Args : Earg_Arr) is + begin + if not Flags.Flag_Elaborate_With_Outdated then + if Loc = Null_Iir then + Error_Msg_Sem (Command_Line_Location, Msg, Args); + else + Error_Msg_Sem (+Loc, Msg, Args); + end if; + end if; + end Error_Obsolete; + + -- Check if one of its dependency makes this unit obsolete. + function Check_Obsolete_Dependence (Design_Unit : Iir; Loc : Iir) + return Boolean + is + List : constant Iir_List := Get_Dependence_List (Design_Unit); + Du_Ts : constant Time_Stamp_Id := + Get_Analysis_Time_Stamp (Get_Design_File (Design_Unit)); + U_Ts : Time_Stamp_Id; + El : Iir; + It : List_Iterator; + begin + if List = Null_Iir_List then + return False; + end if; + + It := List_Iterate (List); + while Is_Valid (It) loop + El := Get_Element (It); + if Get_Kind (El) = Iir_Kind_Design_Unit then + U_Ts := Get_Analysis_Time_Stamp (Get_Design_File (El)); + if Files_Map.Is_Gt (U_Ts, Du_Ts) then + Error_Obsolete + (Loc, "%n is obsoleted by %n", (+Design_Unit, +El)); + return True; + end if; + end if; + Next (It); + end loop; + + return False; + end Check_Obsolete_Dependence; + + procedure Explain_Obsolete (Design_Unit : Iir_Design_Unit; Loc : Iir) + is + List : Iir_List; + It : List_Iterator; + El : Iir; + begin + pragma Assert (Get_Date_State (Design_Unit) = Date_Analyze); + pragma Assert (Get_Date (Design_Unit) = Date_Obsolete); + + List := Get_Dependence_List (Design_Unit); + if List = Null_Iir_List then + -- Argh, we don't know why. + Error_Obsolete (Loc, "%n is obsolete", (1 => +Design_Unit)); + return; + end if; + + It := List_Iterate (List); + while Is_Valid (It) loop + El := Get_Element (It); + if Get_Date (El) = Date_Obsolete then + Error_Obsolete (Loc, "%n is obsoleted by %n", (+Design_Unit, +El)); + return; + end if; + Next (It); + end loop; + end Explain_Obsolete; + + -- Load, parse, analyze, back-end a design_unit if necessary. + procedure Load_Design_Unit (Design_Unit : Iir_Design_Unit; Loc : Iir) + is + Warnings : Warnings_Setting; + begin + if Get_Date (Design_Unit) = Date_Replacing then + Error_Msg_Sem (+Loc, "circular reference of %n", +Design_Unit); + return; + end if; + + if Get_Date_State (Design_Unit) = Date_Disk then + Load_Parse_Design_Unit (Design_Unit, Loc); + end if; + + if Get_Date_State (Design_Unit) = Date_Parse then + -- Analyze the design unit. + + if Get_Date (Design_Unit) = Date_Analyzed then + -- Work-around for an internal check in sem. + -- FIXME: to be removed ? + Set_Date (Design_Unit, Date_Parsed); + end if; + + -- Avoid infinite recursion, if the unit is self-referenced. + Set_Date_State (Design_Unit, Date_Analyze); + + -- Disable all warnings. Warnings are emitted only when the unit + -- is analyzed. + Save_Warnings_Setting (Warnings); + Disable_All_Warnings; + + -- Analyze unit. + Finish_Compilation (Design_Unit); + + -- Restore warnings. + Restore_Warnings_Setting (Warnings); + + -- Check if one of its dependency makes this unit obsolete. + -- FIXME: to do when the dependency is added ? + if not Flags.Flag_Elaborate_With_Outdated + and then Check_Obsolete_Dependence (Design_Unit, Loc) + then + Set_Date (Design_Unit, Date_Obsolete); + return; + end if; + end if; + + case Get_Date (Design_Unit) is + when Date_Parsed => + raise Internal_Error; + when Date_Analyzing => + -- Self-referenced unit. + return; + when Date_Analyzed => + -- FIXME: Accept it silently ? + -- Note: this is used when Flag_Elaborate_With_Outdated is set. + -- This is also used by anonymous configuration declaration. + null; + when Date_Uptodate => + return; + when Date_Valid => + null; + when Date_Obsolete => + if not Flags.Flag_Elaborate_With_Outdated then + Explain_Obsolete (Design_Unit, Loc); + end if; + when others => + raise Internal_Error; + end case; + end Load_Design_Unit; + + function Load_Primary_Unit + (Library: Iir_Library_Declaration; Name: Name_Id; Loc : Iir) + return Iir_Design_Unit + is + Design_Unit: Iir_Design_Unit; + begin + Design_Unit := Find_Primary_Unit (Library, Name); + if Design_Unit /= Null_Iir then + Load_Design_Unit (Design_Unit, Loc); + end if; + return Design_Unit; + end Load_Primary_Unit; + + -- Load an secondary unit and analyse it. + function Load_Secondary_Unit + (Primary: Iir_Design_Unit; Name: Name_Id; Loc : Iir) + return Iir_Design_Unit + is + Design_Unit: Iir_Design_Unit; + begin + Design_Unit := Find_Secondary_Unit (Primary, Name); + if Design_Unit /= Null_Iir then + Load_Design_Unit (Design_Unit, Loc); + end if; + return Design_Unit; + end Load_Secondary_Unit; +end Sem_Lib; diff --git a/src/vhdl/sem_lib.ads b/src/vhdl/sem_lib.ads new file mode 100644 index 000000000..7fb168a8c --- /dev/null +++ b/src/vhdl/sem_lib.ads @@ -0,0 +1,41 @@ +with Types; use Types; +with Iirs; use Iirs; + +package Sem_Lib is + -- Start the analyse a file (ie load and parse it). + -- The file is read from the current directory (unless FILE_NAME is an + -- absolute path). + -- Emit an error if the file cannot be opened. + -- Return NULL_IIR in case of parse error. + function Load_File (File_Name: Name_Id) return Iir_Design_File; + function Load_File (File : Source_File_Entry) return Iir_Design_File; + + -- Load, parse, analyze, back-end a design_unit if necessary. + -- Check Design_Unit is not obsolete. + -- LOC is the location where the design unit was needed, in case of error. + procedure Load_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir); + + -- Load and parse DESIGN_UNIT. + -- Contrary to Load_Design_Unit, the design_unit is not analyzed. + -- Also, the design_unit must not have been already loaded. + -- Used almost only by Load_Design_Unit. + procedure Load_Parse_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir); + + -- Load an already analyzed primary unit NAME from library LIBRARY + -- and compile it. + -- Return NULL_IIR if not found (ie, NAME does not correspond to a + -- library unit identifier). + function Load_Primary_Unit + (Library: Iir_Library_Declaration; Name: Name_Id; Loc : Iir) + return Iir_Design_Unit; + + -- Load an secondary unit of primary unit PRIMARY and analyse it. + -- NAME must be set only for an architecture. + function Load_Secondary_Unit + (Primary: Iir_Design_Unit; Name: Name_Id; Loc : Iir) + return Iir_Design_Unit; + + -- Analyze UNIT. + procedure Finish_Compilation + (Unit : Iir_Design_Unit; Main : Boolean := False); +end Sem_Lib; diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb index 033762bd5..09d99d8d5 100644 --- a/src/vhdl/sem_names.adb +++ b/src/vhdl/sem_names.adb @@ -17,7 +17,6 @@ -- 02111-1307, USA. with Evaluation; use Evaluation; with Iirs_Utils; use Iirs_Utils; -with Libraries; with Errorout; use Errorout; with Flags; use Flags; with Name_Table; @@ -26,6 +25,7 @@ with Types; use Types; with Iir_Chains; use Iir_Chains; with Std_Names; with Sem; +with Sem_Lib; use Sem_Lib; with Sem_Scopes; use Sem_Scopes; with Sem_Expr; use Sem_Expr; with Sem_Stmts; use Sem_Stmts; @@ -1849,7 +1849,7 @@ package body Sem_Names is -- For a design unit, return the library unit if Get_Kind (Res) = Iir_Kind_Design_Unit then -- FIXME: should replace interpretation ? - Libraries.Load_Design_Unit (Res, Name); + Load_Design_Unit (Res, Name); Sem.Add_Dependence (Res); Res := Get_Library_Unit (Res); end if; @@ -2150,7 +2150,7 @@ package body Sem_Names is -- An expanded name is not allowed for a secondary unit, -- particularly for an architecture body. -- GHDL: FIXME: error message more explicit - Res := Libraries.Load_Primary_Unit (Prefix, Suffix, Name); + Res := Load_Primary_Unit (Prefix, Suffix, Name); if Res /= Null_Iir then Sem.Add_Dependence (Res); Res := Get_Library_Unit (Res); @@ -2178,7 +2178,7 @@ package body Sem_Names is -- literal, or operator symbol of an named entity whose -- declaration occurs immediatly within that construct. if Get_Kind (Prefix) = Iir_Kind_Design_Unit then - Libraries.Load_Design_Unit (Prefix, Name); + Load_Design_Unit (Prefix, Name); Sem.Add_Dependence (Prefix); Prefix := Get_Library_Unit (Prefix); -- Modified only for xrefs, since a design_unit points to diff --git a/src/vhdl/sem_specs.adb b/src/vhdl/sem_specs.adb index 6e28c5b39..7f91d38b1 100644 --- a/src/vhdl/sem_specs.adb +++ b/src/vhdl/sem_specs.adb @@ -22,6 +22,7 @@ with Evaluation; use Evaluation; with Std_Package; use Std_Package; with Errorout; use Errorout; with Sem; use Sem; +with Sem_Lib; use Sem_Lib; with Sem_Scopes; use Sem_Scopes; with Sem_Assocs; use Sem_Assocs; with Libraries; @@ -1539,7 +1540,7 @@ package body Sem_Specs is null; end if; - Design_Unit := Libraries.Load_Primary_Unit + Design_Unit := Load_Primary_Unit (Get_Library (Get_Design_File (Entity_Unit)), Get_Identifier (Get_Library_Unit (Entity_Unit)), Parent); diff --git a/src/vhdl/sem_types.adb b/src/vhdl/sem_types.adb index d57d7d5fc..5f9438a8f 100644 --- a/src/vhdl/sem_types.adb +++ b/src/vhdl/sem_types.adb @@ -20,7 +20,6 @@ with Flags; use Flags; with Types; use Types; with Errorout; use Errorout; with Evaluation; use Evaluation; -with Sem; with Sem_Utils; with Sem_Expr; use Sem_Expr; with Sem_Scopes; use Sem_Scopes; @@ -1383,7 +1382,7 @@ package body Sem_Types is (+Atype, "no matching resolution function for %n", +Name); else Name1 := Finish_Sem_Name (Name); - Mark_Subprogram_Used (Res); + Sem_Decls.Mark_Subprogram_Used (Res); Set_Resolved_Flag (Atype, True); Set_Resolution_Indication (Atype, Name1); end if; diff --git a/src/vhdl/std_package.adb b/src/vhdl/std_package.adb index 5700bdf70..02f604936 100644 --- a/src/vhdl/std_package.adb +++ b/src/vhdl/std_package.adb @@ -23,7 +23,6 @@ with Std_Names; use Std_Names; with Flags; use Flags; with Iirs_Utils; with Sem_Utils; -with Sem_Decls; with Iir_Chains; package body Std_Package is diff --git a/src/vhdl/translate/ortho_front.adb b/src/vhdl/translate/ortho_front.adb index 8e0532738..d7dee0015 100644 --- a/src/vhdl/translate/ortho_front.adb +++ b/src/vhdl/translate/ortho_front.adb @@ -25,6 +25,7 @@ with Flags; with Configuration; with Translation; with Sem; +with Sem_Lib; use Sem_Lib; with Errorout; use Errorout; with GNAT.OS_Lib; with Bug; @@ -268,7 +269,7 @@ package body Ortho_Front is Flags.Flag_Elaborate := False; -- Read and parse the file. - Res := Libraries.Load_File (Vhdl_File); + Res := Load_File (Vhdl_File); if Errorout.Nbr_Errors > 0 then raise Compilation_Error; end if; @@ -279,7 +280,7 @@ package body Ortho_Front is Design := Get_First_Design_Unit (Res); while Is_Valid (Design) loop -- Analyze and canon a design unit. - Libraries.Finish_Compilation (Design, True); + Finish_Compilation (Design, True); Next_Design := Get_Chain (Design); if Errorout.Nbr_Errors = 0 then @@ -449,7 +450,7 @@ package body Ortho_Front is begin L := Anaelab_Files; while L /= null loop - Res := Libraries.Load_File (L.Id); + Res := Load_File (L.Id); if Errorout.Nbr_Errors > 0 then raise Compilation_Error; end if; diff --git a/src/vhdl/translate/trans-chap12.adb b/src/vhdl/translate/trans-chap12.adb index dfd50856c..2f8884841 100644 --- a/src/vhdl/translate/trans-chap12.adb +++ b/src/vhdl/translate/trans-chap12.adb @@ -26,6 +26,7 @@ with Name_Table; with Libraries; with Flags; with Sem; +with Sem_Lib; use Sem_Lib; with Trans.Chap1; with Trans.Chap2; with Trans.Chap6; @@ -360,7 +361,7 @@ package body Trans.Chap12 is Decl : Iir; begin - Libraries.Load_Design_Unit (Unit, Null_Iir); + Load_Design_Unit (Unit, Null_Iir); Pkg := Get_Library_Unit (Unit); Reset_Identifier_Prefix; Lib := Get_Library (Get_Design_File (Get_Design_Unit (Pkg))); @@ -434,7 +435,7 @@ package body Trans.Chap12 is Lib_Unit : Iir; begin -- Load the unit in memory to compute the dependence list. - Libraries.Load_Design_Unit (Unit, Null_Iir); + Load_Design_Unit (Unit, Null_Iir); Update_Node_Infos; Set_Elab_Flag (Unit, True); |