aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorTristan Gingold <tgingold@free.fr>2018-11-14 18:35:41 +0100
committerTristan Gingold <tgingold@free.fr>2018-11-14 18:35:41 +0100
commitb6c523106ab498375a7874923742c6b806700a9a (patch)
tree83f21964f8290a845a9acaba325056f5a420a963
parent12ea165c7474ad0a7a486062f816071378492eed (diff)
downloadghdl-b6c523106ab498375a7874923742c6b806700a9a.tar.gz
ghdl-b6c523106ab498375a7874923742c6b806700a9a.tar.bz2
ghdl-b6c523106ab498375a7874923742c6b806700a9a.zip
Create sem_lib from libraries.
-rw-r--r--src/ghdldrv/ghdlcomp.adb11
-rw-r--r--src/ghdldrv/ghdllocal.adb17
-rw-r--r--src/ghdldrv/ghdlprint.adb15
-rw-r--r--src/ghdldrv/ghdlxml.adb3
-rw-r--r--src/libraries.adb379
-rw-r--r--src/libraries.ads51
-rw-r--r--src/vhdl/configuration.adb11
-rw-r--r--src/vhdl/iirs_utils.adb15
-rw-r--r--src/vhdl/iirs_utils.ads4
-rw-r--r--src/vhdl/sem.adb17
-rw-r--r--src/vhdl/sem_assocs.adb3
-rw-r--r--src/vhdl/sem_decls.adb17
-rw-r--r--src/vhdl/sem_decls.ads4
-rw-r--r--src/vhdl/sem_expr.adb3
-rw-r--r--src/vhdl/sem_inst.adb1
-rw-r--r--src/vhdl/sem_lib.adb388
-rw-r--r--src/vhdl/sem_lib.ads41
-rw-r--r--src/vhdl/sem_names.adb8
-rw-r--r--src/vhdl/sem_specs.adb3
-rw-r--r--src/vhdl/sem_types.adb3
-rw-r--r--src/vhdl/std_package.adb1
-rw-r--r--src/vhdl/translate/ortho_front.adb7
-rw-r--r--src/vhdl/translate/trans-chap12.adb5
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);