-- VHDL libraries handling. -- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold -- -- GHDL is free software; you can redistribute it and/or modify it under -- the terms of the GNU General Public License as published by the Free -- Software Foundation; either version 2, or (at your option) any later -- version. -- -- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY -- WARRANTY; without even the implied warranty of MERCHANTABILITY or -- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- for more details. -- -- You should have received a copy of the GNU General Public License -- along with 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.Text_IO; use Ada.Text_IO; with GNAT.Table; with GNAT.OS_Lib; with Interfaces.C_Streams; with System; with Errorout; use Errorout; with Scanner; with Iirs_Utils; use Iirs_Utils; with Parse; with Back_End; with Name_Table; use Name_Table; with Str_Table; with Sem_Scopes; with Tokens; with Files_Map; with Flags; with Std_Package; package body Libraries is -- Chain of known libraries. This is also the top node of all iir node. Libraries_Chain : Iir_Library_Declaration := Null_Iir; Libraries_Chain_Last : Iir_Library_Declaration := Null_Iir; -- A location for any implicit declarations (such as library WORK). Implicit_Location: Location_Type; -- Table of library pathes. package Pathes is new GNAT.Table (Table_Index_Type => Integer, Table_Component_Type => Name_Id, Table_Low_Bound => 1, Table_Initial => 4, Table_Increment => 100); -- Initialize pathes table. -- Set the local path. procedure Init_Pathes is begin Name_Nil := Get_Identifier (""); Pathes.Append (Name_Nil); Local_Directory := Name_Nil; Work_Directory := Name_Nil; end Init_Pathes; function Path_To_Id (Path : String) return Name_Id is begin if Path (Path'Last) /= GNAT.OS_Lib.Directory_Separator then return Get_Identifier (Path & GNAT.OS_Lib.Directory_Separator); else return Get_Identifier (Path); end if; end Path_To_Id; procedure Add_Library_Path (Path : String) is begin if Path'Length = 0 then return; end if; -- Nice message instead of constraint_error. if Path'Length + 2 >= Name_Buffer'Length then Error_Msg ("argument of -P is too long"); return; end if; Pathes.Append (Path_To_Id (Path)); end Add_Library_Path; function Get_Nbr_Pathes return Natural is begin return Pathes.Last; end Get_Nbr_Pathes; function Get_Path (N : Natural) return Name_Id is begin if N > Pathes.Last or N < Pathes.First then raise Constraint_Error; end if; return Pathes.Table (N); end Get_Path; -- Set PATH as the path of the work library. procedure Set_Work_Library_Path (Path : String) is begin Work_Directory := Path_To_Id (Path); if not GNAT.OS_Lib.Is_Directory (Get_Address (Work_Directory)) then -- This is a warning, since 'clean' action should not fail in -- this cases. Warning_Msg ("directory '" & Path & "' set by --workdir= does not exist"); -- raise Option_Error; end if; end Set_Work_Library_Path; -- Open LIBRARY map file, return TRUE if successful. function Set_Library_File_Name (Dir : Name_Id; Library: Iir_Library_Declaration) return Boolean is File_Name : constant String := Back_End.Library_To_File_Name (Library); Fe : Source_File_Entry; begin Fe := Files_Map.Load_Source_File (Dir, Get_Identifier (File_Name)); if Fe = No_Source_File_Entry then return False; end if; Scanner.Set_File (Fe); return True; end Set_Library_File_Name; -- Every design unit is put in this hash table to be quickly found by -- its (primary) identifier. Unit_Hash_Length : constant Name_Id := 127; subtype Hash_Id is Name_Id range 0 .. Unit_Hash_Length - 1; Unit_Hash_Table : array (Hash_Id) of Iir := (others => Null_Iir); -- Get the hash value for DESIGN_UNIT. -- Architectures use the entity name. function Get_Hash_Id_For_Unit (Design_Unit : Iir_Design_Unit) return Hash_Id is Lib_Unit : Iir; Id : Name_Id; begin Lib_Unit := Get_Library_Unit (Design_Unit); case Get_Kind (Lib_Unit) is when Iir_Kind_Entity_Declaration | Iir_Kind_Configuration_Declaration | Iir_Kind_Package_Declaration | Iir_Kind_Package_Body | Iir_Kind_Package_Instantiation_Declaration => Id := Get_Identifier (Lib_Unit); when Iir_Kind_Architecture_Body => -- Architectures are put with the entity identifier. Id := Get_Entity_Identifier_Of_Architecture (Lib_Unit); when others => Error_Kind ("get_Hash_Id_For_Unit", Lib_Unit); end case; return Id mod Unit_Hash_Length; end Get_Hash_Id_For_Unit; -- Put DESIGN_UNIT into the unit hash table. procedure Add_Unit_Hash (Design_Unit : Iir) is Id : Hash_Id; begin Id := Get_Hash_Id_For_Unit (Design_Unit); Set_Hash_Chain (Design_Unit, Unit_Hash_Table (Id)); Unit_Hash_Table (Id) := Design_Unit; end Add_Unit_Hash; -- Remove DESIGN_UNIT from the unit hash table. procedure Remove_Unit_Hash (Design_Unit : Iir) is Id : Hash_Id; Unit, Prev, Next : Iir_Design_Unit; begin Id := Get_Hash_Id_For_Unit (Design_Unit); Unit := Unit_Hash_Table (Id); Prev := Null_Iir; while Unit /= Null_Iir loop Next := Get_Hash_Chain (Unit); if Unit = Design_Unit then if Prev = Null_Iir then Unit_Hash_Table (Id) := Next; else Set_Hash_Chain (Prev, Next); end if; return; end if; Prev := Unit; Unit := Next; end loop; -- Not found. raise Internal_Error; end Remove_Unit_Hash; procedure Purge_Design_File (Design_File : Iir_Design_File) is Prev, File, Next : Iir_Design_File; Unit : Iir_Design_Unit; File_Name : Name_Id; Dir_Name : Name_Id; begin File_Name := Get_Design_File_Filename (Design_File); Dir_Name := Get_Design_File_Directory (Design_File); File := Get_Design_File_Chain (Work_Library); Prev := Null_Iir; while File /= Null_Iir loop Next := Get_Chain (File); if Get_Design_File_Filename (File) = File_Name and then Get_Design_File_Directory (File) = Dir_Name then -- Remove from library. if Prev = Null_Iir then Set_Design_File_Chain (Work_Library, Next); else Set_Chain (Prev, Next); end if; -- Remove all units from unit hash table. Unit := Get_First_Design_Unit (File); while Unit /= Null_Iir loop Remove_Unit_Hash (Unit); Unit := Get_Chain (Unit); end loop; return; end if; Prev := File; File := Next; end loop; end Purge_Design_File; -- Load the contents of a library from a map file. -- The format of this file, used by save_library and load_library is -- as follow: -- -- file_format ::= header { design_file_format } -- header ::= v 3 -- design_file_format ::= -- filename_format { design_unit_format } -- filename_format ::= -- FILE directory "FILENAME" file_time_stamp analyze_time_stamp: -- design_unit_format ::= entity_format -- | architecture_format -- | package_format -- | package_body_format -- | configuration_format -- position_format ::= LINE(POS) + OFF on DATE -- entity_format ::= -- ENTITY identifier AT position_format ; -- architecture_format ::= -- ARCHITECTURE identifier of name AT position_format ; -- package_format ::= -- PACKAGE identifier AT position_format [BODY] ; -- package_body_format ::= -- PACKAGE BODY identifier AT position_format ; -- configuration_format ::= -- CONFIGURATION identifier AT position_format ; -- -- The position_format meaning is: -- LINE is the line number (first line is number 1), -- POS is the offset of this line number, as a source_ptr value, -- OFF is the offset in the line, starting with 0. -- DATE is the symbolic date of analysis (order). -- -- Return TRUE if the library was found. function Load_Library (Library: Iir_Library_Declaration) return Boolean is use Scanner; use Tokens; File : Source_File_Entry; procedure Bad_Library_Format is begin Error_Msg (Image (Files_Map.Get_File_Name (File)) & ": bad library format"); end Bad_Library_Format; procedure Scan_Expect (Tok: Token_Type) is begin Scan; if Current_Token /= Tok then Bad_Library_Format; raise Compilation_Error; end if; end Scan_Expect; function Current_Time_Stamp return Time_Stamp_Id is begin if Current_String_Length /= Time_Stamp_String'Length then Bad_Library_Format; raise Compilation_Error; end if; return Time_Stamp_Id (Current_String_Id); end Current_Time_Stamp; function String_To_Name_Id return Name_Id is Len : Int32; Ptr : String_Fat_Acc; begin Len := Current_String_Length; Ptr := Str_Table.Get_String_Fat_Acc (Current_String_Id); for I in 1 .. Len loop Name_Table.Name_Buffer (Natural (I)) := Ptr (I); end loop; Name_Table.Name_Length := Natural (Len); -- FIXME: should remove last string. return Get_Identifier; end String_To_Name_Id; Design_Unit, Last_Design_Unit : Iir_Design_Unit; Lib_Ident : Name_Id; function Scan_Unit_List return Iir_List is begin if Current_Token = Tok_Left_Paren then Scan_Expect (Tok_Identifier); loop Scan_Expect (Tok_Dot); Scan_Expect (Tok_Identifier); Scan; if Current_Token = Tok_Left_Paren then -- This is an architecture. Scan_Expect (Tok_Identifier); Scan_Expect (Tok_Right_Paren); Scan; end if; exit when Current_Token /= Tok_Comma; Scan; end loop; Scan; end if; return Null_Iir_List; end Scan_Unit_List; Design_File: Iir_Design_File; Library_Unit: Iir; Line, Col: Int32; File_Dir : Name_Id; Pos: Source_Ptr; Date: Date_Type; Max_Date: Date_Type := Date_Valid'First; Dir : Name_Id; begin Lib_Ident := Get_Identifier (Library); if False then Ada.Text_IO.Put_Line ("Load library " & Image (Lib_Ident)); end if; -- Check the library was not already loaded. if Get_Design_File_Chain (Library) /= Null_Iir then raise Internal_Error; end if; -- Try to open the library file map. Dir := Get_Library_Directory (Library); if Dir = Null_Identifier then -- Search in the library path. declare File_Name : constant String := Back_End.Library_To_File_Name (Library); L : Natural; begin for I in Pathes.First .. Pathes.Last loop Image (Pathes.Table (I)); L := Name_Length + File_Name'Length; Name_Buffer (Name_Length + 1 .. L) := File_Name; Name_Buffer (L + 1) := Character'Val (0); if GNAT.OS_Lib.Is_Regular_File (Name_Buffer'Address) then Dir := Pathes.Table (I); Set_Library_Directory (Library, Dir); exit; end if; end loop; end; end if; if Dir = Null_Identifier or else not Set_Library_File_Name (Dir, Library) then -- Not found. Set_Date (Library, Date_Valid'First); return False; end if; File := Get_Current_Source_File; -- Parse header. Scan; if Current_Token /= Tok_Identifier or else Name_Length /= 1 or else Name_Buffer (1) /= 'v' then Bad_Library_Format; raise Compilation_Error; end if; Scan_Expect (Tok_Integer); if Current_Iir_Int64 not in 1 .. 3 then Bad_Library_Format; raise Compilation_Error; end if; Scan; Last_Design_Unit := Null_Iir; while Current_Token /= Tok_Eof loop if Current_Token = Tok_File then -- This is a new design file. Design_File := Create_Iir (Iir_Kind_Design_File); Scan; if Current_Token = Tok_Dot then -- The filename is local, use the directory of the library. if Dir = Name_Nil then File_Dir := Files_Map.Get_Home_Directory; else File_Dir := Dir; end if; elsif Current_Token = Tok_Slash then -- The filename is an absolute file. File_Dir := Null_Identifier; elsif Current_Token = Tok_String then -- Be compatible with version 1: an empty directory for -- an absolute filename. if Current_String_Length = 0 then File_Dir := Null_Identifier; else File_Dir := String_To_Name_Id; end if; else Bad_Library_Format; raise Compilation_Error; end if; Set_Design_File_Directory (Design_File, File_Dir); Scan_Expect (Tok_String); Set_Design_File_Filename (Design_File, String_To_Name_Id); -- FIXME: check the file name is uniq. Set_Parent (Design_File, Library); -- Prepend. Set_Chain (Design_File, Get_Design_File_Chain (Library)); Set_Design_File_Chain (Library, Design_File); Scan_Expect (Tok_String); Set_File_Time_Stamp (Design_File, Current_Time_Stamp); Scan_Expect (Tok_String); Set_Analysis_Time_Stamp (Design_File, Current_Time_Stamp); Scan_Expect (Tok_Colon); Scan; Last_Design_Unit := Null_Iir; else -- This is a new design unit. Design_Unit := Create_Iir (Iir_Kind_Design_Unit); Set_Design_File (Design_Unit, Design_File); case Current_Token is when Tok_Entity => Library_Unit := Create_Iir (Iir_Kind_Entity_Declaration); Scan; when Tok_Architecture => Library_Unit := Create_Iir (Iir_Kind_Architecture_Body); Scan; when Tok_Configuration => Library_Unit := Create_Iir (Iir_Kind_Configuration_Declaration); Scan; when Tok_Package => Scan; if Current_Token = Tok_Body then Library_Unit := Create_Iir (Iir_Kind_Package_Body); Scan; else Library_Unit := Create_Iir (Iir_Kind_Package_Declaration); end if; when Tok_With => if Library_Unit = Null_Iir or else Get_Kind (Library_Unit) /= Iir_Kind_Architecture_Body then Put_Line ("load_library: invalid use of 'with'"); raise Internal_Error; end if; Scan_Expect (Tok_Configuration); Scan_Expect (Tok_Colon); Scan; Set_Dependence_List (Design_Unit, Scan_Unit_List); goto Next_Line; when others => Put_Line ("load_library: line must start with " & "'architecture', 'entity', 'package' or 'configuration'"); raise Internal_Error; end case; if Current_Token /= Tok_Identifier then raise Internal_Error; end if; Set_Identifier (Library_Unit, Current_Identifier); Set_Identifier (Design_Unit, Current_Identifier); if Get_Kind (Library_Unit) = Iir_Kind_Architecture_Body then Scan_Expect (Tok_Of); Scan_Expect (Tok_Identifier); Set_Entity_Name (Library_Unit, Current_Text); end if; -- Scan position. Scan_Expect (Tok_Identifier); -- at Scan_Expect (Tok_Integer); Line := Int32 (Current_Iir_Int64); Scan_Expect (Tok_Left_Paren); Scan_Expect (Tok_Integer); Pos := Source_Ptr (Current_Iir_Int64); Scan_Expect (Tok_Right_Paren); Scan_Expect (Tok_Plus); Scan_Expect (Tok_Integer); Col := Int32 (Current_Iir_Int64); Scan_Expect (Tok_On); Scan_Expect (Tok_Integer); Date := Date_Type (Current_Iir_Int64); Scan; if Get_Kind (Library_Unit) = Iir_Kind_Package_Declaration and then Current_Token = Tok_Body then Set_Need_Body (Library_Unit, True); Scan; end if; if Current_Token /= Tok_Semi_Colon then raise Internal_Error; end if; Scan; if False then Put_Line ("line:" & Int32'Image (Line) & ", pos:" & Source_Ptr'Image (Pos)); end if; -- Scan dependence list. Set_Dependence_List (Design_Unit, Scan_Unit_List); -- Keep the position of the design unit. --Set_Location (Design_Unit, Location_Type (File)); --Set_Location (Library_Unit, Location_Type (File)); Set_Design_Unit_Source_Pos (Design_Unit, Pos); Set_Design_Unit_Source_Line (Design_Unit, Line); Set_Design_Unit_Source_Col (Design_Unit, Col); Set_Date (Design_Unit, Date); if Date > Max_Date then Max_Date := Date; end if; Set_Date_State (Design_Unit, Date_Disk); Set_Library_Unit (Design_Unit, Library_Unit); Set_Design_Unit (Library_Unit, Design_Unit); -- Add in the unit hash table. Add_Unit_Hash (Design_Unit); if Last_Design_Unit = Null_Iir then Set_First_Design_Unit (Design_File, Design_Unit); else Set_Chain (Last_Design_Unit, Design_Unit); end if; Last_Design_Unit := Design_Unit; Set_Last_Design_Unit (Design_File, Design_Unit); end if; << Next_Line >> null; end loop; Set_Date (Library, Max_Date); Close_File; return True; end Load_Library; procedure Create_Virtual_Locations is use Files_Map; Implicit_Source_File : Source_File_Entry; Command_Source_File : Source_File_Entry; begin Implicit_Source_File := Create_Virtual_Source_File (Get_Identifier ("*implicit*")); Command_Source_File := Create_Virtual_Source_File (Get_Identifier ("*command line*")); Command_Line_Location := Source_File_To_Location (Command_Source_File); Implicit_Location := Source_File_To_Location (Implicit_Source_File); end Create_Virtual_Locations; -- Note: the scanner shouldn't be in use, since this procedure uses it. procedure Load_Std_Library (Build_Standard : Boolean := True) is use Std_Package; Dir : Name_Id; begin if Libraries_Chain /= Null_Iir then -- This procedure must not be called twice. raise Internal_Error; end if; Flags.Create_Flag_String; Create_Virtual_Locations; Std_Package.Create_First_Nodes; -- Create the library. Std_Library := Create_Iir (Iir_Kind_Library_Declaration); Set_Identifier (Std_Library, Std_Names.Name_Std); Set_Location (Std_Library, Implicit_Location); Libraries_Chain := Std_Library; Libraries_Chain_Last := Std_Library; if Build_Standard then Create_Std_Standard_Package (Std_Library); Add_Unit_Hash (Std_Standard_Unit); end if; if Flags.Bootstrap and then Work_Library_Name = Std_Names.Name_Std then Dir := Work_Directory; else Dir := Null_Identifier; end if; Set_Library_Directory (Std_Library, Dir); if Load_Library (Std_Library) = False and then not Flags.Bootstrap then Error_Msg_Option ("cannot find ""std"" library"); end if; if Build_Standard then -- Add the standard_file into the library. -- This is done after Load_Library, because it checks there is no -- previous files in the library. Set_Parent (Std_Standard_File, Std_Library); Set_Chain (Std_Standard_File, Get_Design_File_Chain (Std_Library)); Set_Design_File_Chain (Std_Library, Std_Standard_File); end if; Set_Visible_Flag (Std_Library, True); end Load_Std_Library; procedure Load_Work_Library (Empty : Boolean := False) is use Std_Names; begin if Work_Library_Name = Name_Std then if not Flags.Bootstrap then Error_Msg_Option ("the WORK library cannot be STD"); return; end if; Work_Library := Std_Library; else Work_Library := Create_Iir (Iir_Kind_Library_Declaration); Set_Location (Work_Library, Implicit_Location); --Set_Visible_Flag (Work_Library, True); Set_Library_Directory (Work_Library, Work_Directory); Set_Identifier (Work_Library, Work_Library_Name); if not Empty then if Load_Library (Work_Library) = False then null; end if; end if; -- Add it to the list of libraries. Set_Chain (Libraries_Chain_Last, Work_Library); Libraries_Chain_Last := Work_Library; end if; Set_Visible_Flag (Work_Library, True); end Load_Work_Library; -- Get or create a library from an identifier. function Get_Library (Ident: Name_Id; Loc : Location_Type) return Iir_Library_Declaration is Library: Iir_Library_Declaration; begin -- library work is a little bit special. if Ident = Std_Names.Name_Work or else Ident = Work_Library_Name then if Work_Library = Null_Iir then -- load_work_library must have been called before. raise Internal_Error; end if; return Work_Library; end if; -- Check if the library has already been loaded. Library := Iirs_Utils.Find_Name_In_Chain (Libraries_Chain, Ident); if Library /= Null_Iir then return Library; end if; -- This is a new library. if Ident = Std_Names.Name_Std then -- Load_std_library must have been called before. raise Internal_Error; end if; Library := Create_Iir (Iir_Kind_Library_Declaration); Set_Location (Library, Scanner.Get_Token_Location); Set_Library_Directory (Library, Null_Identifier); Set_Identifier (Library, Ident); if Load_Library (Library) = False then Error_Msg_Sem ("cannot find resource library """ & Name_Table.Image (Ident) & """", Loc); end if; Set_Visible_Flag (Library, True); Set_Chain (Libraries_Chain_Last, Library); Libraries_Chain_Last := Library; return Library; end Get_Library; -- Return TRUE if LIBRARY_UNIT and UNIT have identifiers for the same -- design unit identifier. -- eg: 'entity A' and 'package A' returns TRUE. function Is_Same_Library_Unit (Library_Unit, Unit: Iir) return Boolean is Entity_Name1, Entity_Name2: Name_Id; Library_Unit_Kind, Unit_Kind : Iir_Kind; begin if Get_Identifier (Unit) /= Get_Identifier (Library_Unit) then return False; end if; Library_Unit_Kind := Get_Kind (Library_Unit); Unit_Kind := Get_Kind (Unit); -- Package and package body are never the same library unit. if Library_Unit_Kind = Iir_Kind_Package_Declaration and then Unit_Kind = Iir_Kind_Package_Body then return False; end if; if Unit_Kind = Iir_Kind_Package_Declaration and then Library_Unit_Kind = Iir_Kind_Package_Body then return False; end if; -- Two architecture declarations are identical only if they also have -- the same entity name. if Unit_Kind = Iir_Kind_Architecture_Body and then Library_Unit_Kind = Iir_Kind_Architecture_Body then Entity_Name1 := Get_Entity_Identifier_Of_Architecture (Unit); Entity_Name2 := Get_Entity_Identifier_Of_Architecture (Library_Unit); if Entity_Name1 /= Entity_Name2 then return False; end if; end if; -- An architecture declaration never conflits with a library unit that -- is not an architecture declaration. if (Unit_Kind = Iir_Kind_Architecture_Body and then Library_Unit_Kind /= Iir_Kind_Architecture_Body) or else (Unit_Kind /= Iir_Kind_Architecture_Body and then Library_Unit_Kind = Iir_Kind_Architecture_Body) then return False; end if; return True; end Is_Same_Library_Unit; procedure Free_Dependence_List (Design : Iir_Design_Unit) is List : Iir_List; El : Iir; begin List := Get_Dependence_List (Design); if List /= Null_Iir_List then for I in Natural loop El := Get_Nth_Element (List, I); exit when El = Null_Iir; Iirs_Utils.Free_Recursive (El); end loop; 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, -- has it may be referenced in other units (dependence...) -- FIXME: Isn't the library unit also referenced too ? procedure Free_Design_Unit (Design_Unit : Iir_Design_Unit) is Lib : Iir; Unit : Iir_Design_Unit; Dep_List : Iir_List; begin -- Free dependence list. Dep_List := Get_Dependence_List (Design_Unit); Destroy_Iir_List (Dep_List); Set_Dependence_List (Design_Unit, Null_Iir_List); -- Free default configuration of architecture (if any). Lib := Get_Library_Unit (Design_Unit); if Lib /= Null_Iir and then Get_Kind (Lib) = Iir_Kind_Architecture_Body then Free_Iir (Get_Entity_Name (Lib)); Unit := Get_Default_Configuration_Declaration (Lib); if Unit /= Null_Iir then Free_Design_Unit (Unit); end if; end if; -- Free library unit. Free_Iir (Lib); Set_Library_Unit (Design_Unit, Null_Iir); end Free_Design_Unit; procedure Remove_Unit_From_File (Unit_Ref : Iir_Design_Unit; File : Iir_Design_File) is Prev : Iir_Design_Unit; Unit, Next : Iir_Design_Unit; begin Prev := Null_Iir; Unit := Get_First_Design_Unit (File); while Unit /= Null_Iir loop Next := Get_Chain (Unit); if Unit = Unit_Ref then if Prev = Null_Iir then Set_First_Design_Unit (File, Next); else Set_Chain (Prev, Next); end if; if Next = Null_Iir then Set_Last_Design_Unit (File, Prev); end if; return; end if; Prev := Unit; Unit := Next; end loop; -- Not found. raise Internal_Error; end Remove_Unit_From_File; -- Last design_file used. Kept to speed-up operations. Last_Design_File : Iir_Design_File := Null_Iir; -- Add or replace a design unit in the working library. procedure Add_Design_Unit_Into_Library (Unit : in Iir_Design_Unit; Keep_Obsolete : Boolean := False) is Design_File: Iir_Design_File; Design_Unit, Prev_Design_Unit : Iir_Design_Unit; Last_Unit : Iir_Design_Unit; Library_Unit: Iir; New_Library_Unit: Iir; Unit_Id : Name_Id; Date: Date_Type; New_Lib_Time_Stamp : Time_Stamp_Id; Id : Hash_Id; -- File name and dir name of DECL. File_Name : Name_Id; Dir_Name : Name_Id; begin -- As specified, the Chain must be not set. pragma Assert (Get_Chain (Unit) = Null_Iir); -- The unit must not be in the library. pragma Assert (Get_Date_State (Unit) = Date_Extern); -- Mark this design unit as being loaded. New_Library_Unit := Get_Library_Unit (Unit); Unit_Id := Get_Identifier (New_Library_Unit); -- Set the date of the design unit as the most recently analyzed -- design unit. case Get_Date (Unit) is when Date_Parsed => Set_Date_State (Unit, Date_Parse); when Date_Analyzed => Date := Get_Date (Work_Library) + 1; Set_Date (Unit, Date); Set_Date (Work_Library, Date); Set_Date_State (Unit, Date_Analyze); when Date_Valid => raise Internal_Error; when others => raise Internal_Error; end case; -- Set file time stamp. declare File : Source_File_Entry; Pos : Source_Ptr; begin Files_Map.Location_To_File_Pos (Get_Location (New_Library_Unit), File, Pos); New_Lib_Time_Stamp := Files_Map.Get_File_Time_Stamp (File); File_Name := Files_Map.Get_File_Name (File); Image (File_Name); if GNAT.OS_Lib.Is_Absolute_Path (Name_Buffer (1 .. Name_Length)) then Dir_Name := Null_Identifier; else Dir_Name := Files_Map.Get_Home_Directory; end if; end; -- Try to find a design unit with the same name in the work library. Id := Get_Hash_Id_For_Unit (Unit); Design_Unit := Unit_Hash_Table (Id); Prev_Design_Unit := Null_Iir; while Design_Unit /= Null_Iir loop Design_File := Get_Design_File (Design_Unit); Library_Unit := Get_Library_Unit (Design_Unit); if Get_Identifier (Design_Unit) = Unit_Id and then Get_Library (Design_File) = Work_Library and then Is_Same_Library_Unit (New_Library_Unit, Library_Unit) then -- LIBRARY_UNIT and UNIT designate the same design unit. -- Remove the old one. Set_Date (Design_Unit, Date_Obsolete); declare Next_Design : Iir; begin -- Remove DESIGN_UNIT from the unit_hash. Next_Design := Get_Hash_Chain (Design_Unit); if Prev_Design_Unit = Null_Iir then Unit_Hash_Table (Id) := Next_Design; else Set_Hash_Chain (Prev_Design_Unit, Next_Design); end if; -- Remove DESIGN_UNIT from the design_file. -- If KEEP_OBSOLETE is True, units that are obsoleted by units -- in the same design file are kept. This allows to process -- (pretty print, xrefs, ...) all units of a design file. -- But still remove units that are replaced (if a file was -- already in the library). if not Keep_Obsolete or else Get_Date_State (Design_Unit) = Date_Disk then Remove_Unit_From_File (Design_Unit, Design_File); Set_Chain (Design_Unit, Obsoleted_Design_Units); Obsoleted_Design_Units := Design_Unit; end if; end; -- UNIT *must* replace library_unit if they don't belong -- to the same file. if Get_Design_File_Filename (Design_File) = File_Name and then Get_Design_File_Directory (Design_File) = Dir_Name then -- In the same file. if Get_Date_State (Design_Unit) = Date_Analyze then -- Warns only if we are not re-analyzing the file. if Flags.Warn_Library then Warning_Msg_Sem ("redefinition of a library unit in " & "same design file:", Unit); Warning_Msg_Sem (Disp_Node (Library_Unit) & " defined at " & Disp_Location (Library_Unit) & " is now " & Disp_Node (New_Library_Unit), Unit); end if; else -- Free the stub. if not Keep_Obsolete then Free_Design_Unit (Design_Unit); end if; end if; -- Note: the current design unit should not be freed if -- in use; unfortunatly, this is not obvious to check. else if Flags.Warn_Library then if Get_Kind (Library_Unit) /= Get_Kind (New_Library_Unit) then Warning_Msg ("changing definition of a library unit:"); Warning_Msg (Disp_Node (Library_Unit) & " is now " & Disp_Node (New_Library_Unit)); end if; Warning_Msg ("library unit '" & Iirs_Utils.Image_Identifier (Library_Unit) & "' was also defined in file '" & Image (Get_Design_File_Filename (Design_File)) & '''); end if; end if; exit; else Prev_Design_Unit := Design_Unit; Design_Unit := Get_Hash_Chain (Design_Unit); end if; end loop; -- Try to find the design file in the library. -- First try the last one found. if Last_Design_File /= Null_Iir and then Get_Library (Last_Design_File) = Work_Library and then Get_Design_File_Filename (Last_Design_File) = File_Name and then Get_Design_File_Directory (Last_Design_File) = Dir_Name then Design_File := Last_Design_File; else -- Search. Design_File := Get_Design_File_Chain (Work_Library); while Design_File /= Null_Iir loop if Get_Design_File_Filename (Design_File) = File_Name and then Get_Design_File_Directory (Design_File) = Dir_Name then exit; end if; Design_File := Get_Chain (Design_File); end loop; Last_Design_File := Design_File; end if; if Design_File /= Null_Iir and then not Files_Map.Is_Eq (New_Lib_Time_Stamp, Get_File_Time_Stamp (Design_File)) then -- FIXME: this test is not enough: what about reanalyzing -- unmodified files (this works only because the order is not -- changed). -- Design file is updated. -- Outdate all other units, overwrite the design_file. Set_File_Time_Stamp (Design_File, New_Lib_Time_Stamp); Design_Unit := Get_First_Design_Unit (Design_File); while Design_Unit /= Null_Iir loop if Design_Unit /= Unit then -- Mark other design unit as obsolete. Set_Date (Design_Unit, Date_Obsolete); Remove_Unit_Hash (Design_Unit); else raise Internal_Error; end if; Prev_Design_Unit := Design_Unit; Design_Unit := Get_Chain (Design_Unit); Set_Chain (Prev_Design_Unit, Obsoleted_Design_Units); Obsoleted_Design_Units := Prev_Design_Unit; end loop; Set_First_Design_Unit (Design_File, Null_Iir); Set_Last_Design_Unit (Design_File, Null_Iir); end if; if Design_File = Null_Iir then -- This is the first apparition of the design file. Design_File := Create_Iir (Iir_Kind_Design_File); Location_Copy (Design_File, Unit); Set_Design_File_Filename (Design_File, File_Name); Set_Design_File_Directory (Design_File, Dir_Name); Set_File_Time_Stamp (Design_File, New_Lib_Time_Stamp); Set_Parent (Design_File, Work_Library); Set_Chain (Design_File, Get_Design_File_Chain (Work_Library)); Set_Design_File_Chain (Work_Library, Design_File); end if; -- Add DECL to DESIGN_FILE. Last_Unit := Get_Last_Design_Unit (Design_File); if Last_Unit = Null_Iir then if Get_First_Design_Unit (Design_File) /= Null_Iir then raise Internal_Error; end if; Set_First_Design_Unit (Design_File, Unit); else if Get_First_Design_Unit (Design_File) = Null_Iir then raise Internal_Error; end if; Set_Chain (Last_Unit, Unit); end if; Set_Last_Design_Unit (Design_File, Unit); Set_Design_File (Unit, Design_File); -- Add DECL in unit hash table. Set_Hash_Chain (Unit, Unit_Hash_Table (Id)); Unit_Hash_Table (Id) := Unit; -- Update the analyzed time stamp. Set_Analysis_Time_Stamp (Design_File, Files_Map.Get_Os_Time_Stamp); end Add_Design_Unit_Into_Library; procedure Add_Design_File_Into_Library (File : in out Iir_Design_File) is Unit : Iir_Design_Unit; Next_Unit : Iir_Design_Unit; First_Unit : Iir_Design_Unit; begin Unit := Get_First_Design_Unit (File); First_Unit := Unit; Set_First_Design_Unit (File, Null_Iir); Set_Last_Design_Unit (File, Null_Iir); while Unit /= Null_Iir loop Next_Unit := Get_Chain (Unit); Set_Chain (Unit, Null_Iir); Libraries.Add_Design_Unit_Into_Library (Unit, True); Unit := Next_Unit; end loop; if First_Unit /= Null_Iir then File := Get_Design_File (First_Unit); end if; end Add_Design_File_Into_Library; -- Save the file map of library LIBRARY. procedure Save_Library (Library: Iir_Library_Declaration) is use System; use Interfaces.C_Streams; use GNAT.OS_Lib; Temp_Name: constant String := Image (Work_Directory) & '_' & Back_End.Library_To_File_Name (Library) & ASCII.NUL; Mode : constant String := 'w' & ASCII.NUL; Stream : FILEs; Success : Boolean; -- Write a string to the temporary file. procedure WR (S : String) is Close_Res : int; pragma Unreferenced (Close_Res); begin if Integer (fwrite (S'Address, S'Length, 1, Stream)) /= 1 then Error_Msg ("cannot write library file for " & Image_Identifier (Library)); Close_Res := fclose (Stream); Delete_File (Temp_Name'Address, Success); -- Ignore failure to delete the file. raise Option_Error; end if; end WR; -- Write a line terminator in the temporary file. procedure WR_LF is begin WR (String'(1 => ASCII.LF)); end WR_LF; Design_File: Iir_Design_File; Design_Unit: Iir_Design_Unit; Library_Unit: Iir; Dir : Name_Id; Off, Line: Natural; Pos: Source_Ptr; Source_File : Source_File_Entry; begin -- Create a temporary file so that the real library is atomically -- updated, and won't be corrupted in case of Control-C, or concurrent -- writes. Stream := fopen (Temp_Name'Address, Mode'Address); if Stream = NULL_Stream then Error_Msg ("cannot create library file for " & Image_Identifier (Library)); raise Option_Error; end if; -- Header: version. WR ("v 3"); WR_LF; Design_File := Get_Design_File_Chain (Library); while Design_File /= Null_Iir loop -- Ignore std.standard as there is no corresponding file. if Design_File = Std_Package.Std_Standard_File then goto Continue; end if; Design_Unit := Get_First_Design_Unit (Design_File); if Design_Unit /= Null_Iir then WR ("file "); Dir := Get_Design_File_Directory (Design_File); if Dir = Null_Identifier then -- Absolute filenames. WR ("/"); elsif Work_Directory = Name_Nil and then Dir = Files_Map.Get_Home_Directory then -- If the library is in the current directory, do not write -- it. This allows to move the library file. WR ("."); else Image (Dir); WR (""""); WR (Name_Buffer (1 .. Name_Length)); WR (""""); end if; WR (" """); Image (Get_Design_File_Filename (Design_File)); WR (Name_Buffer (1 .. Name_Length)); WR (""" """); WR (Files_Map.Get_Time_Stamp_String (Get_File_Time_Stamp (Design_File))); WR (""" """); WR (Files_Map.Get_Time_Stamp_String (Get_Analysis_Time_Stamp (Design_File))); WR (""":"); WR_LF; end if; while Design_Unit /= Null_Iir loop Library_Unit := Get_Library_Unit (Design_Unit); WR (" "); case Get_Kind (Library_Unit) is when Iir_Kind_Entity_Declaration => WR ("entity "); WR (Image_Identifier (Library_Unit)); when Iir_Kind_Architecture_Body => WR ("architecture "); WR (Image_Identifier (Library_Unit)); WR (" of "); WR (Image (Get_Entity_Identifier_Of_Architecture (Library_Unit))); when Iir_Kind_Package_Declaration | Iir_Kind_Package_Instantiation_Declaration => WR ("package "); WR (Image_Identifier (Library_Unit)); when Iir_Kind_Package_Body => WR ("package body "); WR (Image_Identifier (Library_Unit)); when Iir_Kind_Configuration_Declaration => WR ("configuration "); WR (Image_Identifier (Library_Unit)); when others => Error_Kind ("save_library", Library_Unit); end case; if Get_Date_State (Design_Unit) = Date_Disk then 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)); else Files_Map.Location_To_Coord (Get_Location (Design_Unit), Source_File, Pos, Line, Off); end if; WR (" at"); WR (Natural'Image (Line)); WR ("("); WR (Source_Ptr'Image (Pos)); WR (") +"); WR (Natural'Image (Off)); WR (" on"); case Get_Date (Design_Unit) is when Date_Valid | Date_Analyzed | Date_Parsed => WR (Date_Type'Image (Get_Date (Design_Unit))); when others => WR (Date_Type'Image (Get_Date (Design_Unit))); raise Internal_Error; end case; if Get_Kind (Library_Unit) = Iir_Kind_Package_Declaration and then Get_Need_Body (Library_Unit) then WR (" body"); end if; WR (";"); WR_LF; Design_Unit := Get_Chain (Design_Unit); end loop; << Continue >> null; Design_File := Get_Chain (Design_File); end loop; declare Fclose_Res : int; pragma Unreferenced (Fclose_Res); begin Fclose_Res := fclose (Stream); end; -- Rename the temporary file to the library file. -- FIXME: It may fail if they aren't on the same filesystem, but we -- could assume it doesn't happen (humm...) declare use Files_Map; File_Name: constant String := Image (Work_Directory) & Back_End.Library_To_File_Name (Library) & ASCII.NUL; Delete_Success : Boolean; begin -- For windows: renames doesn't overwrite destination; so first -- delete it. This can create races condition on Unix: if the -- program is killed between delete and rename, the library is lost. Delete_File (File_Name'Address, Delete_Success); Rename_File (Temp_Name'Address, File_Name'Address, Success); if not Success then -- Renaming may fail if the new filename is in a non-existant -- directory. Error_Msg ("cannot update library file """ & File_Name (File_Name'First .. File_Name'Last - 1) & """"); Delete_File (Temp_Name'Address, Success); raise Option_Error; end if; end; end Save_Library; -- Save the map of the work library. procedure Save_Work_Library is begin Save_Library (Work_Library); end Save_Work_Library; -- Return the name of the latest architecture analysed for an entity. function Get_Latest_Architecture (Entity: Iir_Entity_Declaration) return Iir_Architecture_Body is Entity_Id : Name_Id; Lib : Iir_Library_Declaration; Design_File: Iir_Design_File; Design_Unit: Iir_Design_Unit; Library_Unit: Iir; Res: Iir_Design_Unit; begin -- FIXME: use hash Entity_Id := Get_Identifier (Entity); Lib := Get_Library (Get_Design_File (Get_Design_Unit (Entity))); Design_File := Get_Design_File_Chain (Lib); Res := Null_Iir; while Design_File /= Null_Iir loop Design_Unit := Get_First_Design_Unit (Design_File); while Design_Unit /= Null_Iir loop Library_Unit := Get_Library_Unit (Design_Unit); if Get_Kind (Library_Unit) = Iir_Kind_Architecture_Body and then Get_Entity_Identifier_Of_Architecture (Library_Unit) = Entity_Id then if Res = Null_Iir then Res := Design_Unit; elsif Get_Date (Design_Unit) > Get_Date (Res) then Res := Design_Unit; end if; end if; Design_Unit := Get_Chain (Design_Unit); end loop; Design_File := Get_Chain (Design_File); end loop; if Res = Null_Iir then return Null_Iir; else return Get_Library_Unit (Res); 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); Res := Parse.Parse_Design_File; 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 semantized). function Load_File (File_Name: Name_Id) return Iir_Design_File is Fe : Source_File_Entry; begin Fe := Files_Map.Load_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; function Find_Design_Unit (Unit : Iir) return Iir_Design_Unit is begin case Get_Kind (Unit) is when Iir_Kind_Design_Unit => return Unit; when Iir_Kind_Selected_Name => declare Lib : Iir_Library_Declaration; begin Lib := Get_Library (Get_Identifier (Get_Prefix (Unit)), Get_Location (Unit)); return Find_Primary_Unit (Lib, Get_Identifier (Unit)); end; when Iir_Kind_Entity_Aspect_Entity => return Find_Secondary_Unit (Get_Design_Unit (Get_Entity (Unit)), Get_Identifier (Get_Architecture (Unit))); when others => Error_Kind ("find_design_unit", Unit); end case; end Find_Design_Unit; function Is_Obsolete (Design_Unit : Iir_Design_Unit; Loc : Iir) return Boolean is procedure Error_Obsolete (Msg : String) is begin if not Flags.Flag_Elaborate_With_Outdated then Error_Msg_Sem (Msg, Loc); end if; end Error_Obsolete; List : Iir_List; El : Iir; Unit : Iir_Design_Unit; U_Ts : Time_Stamp_Id; Du_Ts : Time_Stamp_Id; begin if Get_Date (Design_Unit) = Date_Obsolete then Error_Obsolete (Disp_Node (Design_Unit) & " is obsolete"); return True; end if; List := Get_Dependence_List (Design_Unit); if List = Null_Iir_List then return False; end if; Du_Ts := Get_Analysis_Time_Stamp (Get_Design_File (Design_Unit)); for I in Natural loop El := Get_Nth_Element (List, I); exit when El = Null_Iir; Unit := Find_Design_Unit (El); if Unit /= Null_Iir then U_Ts := Get_Analysis_Time_Stamp (Get_Design_File (Unit)); if Files_Map.Is_Gt (U_Ts, Du_Ts) then Error_Obsolete (Disp_Node (Design_Unit) & " is obsoleted by " & Disp_Node (Unit)); return True; elsif Is_Obsolete (Unit, Loc) then Error_Obsolete (Disp_Node (Design_Unit) & " depends on obsolete unit"); return True; end if; end if; end loop; return False; end Is_Obsolete; 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 and parse the unit. Design_File := Get_Design_File (Design_Unit); Fe := Files_Map.Load_Source_File (Get_Design_File_Directory (Design_File), Get_Design_File_Filename (Design_File)); if Fe = No_Source_File_Entry then Error_Msg ("cannot load " & Disp_Node (Get_Library_Unit (Design_Unit))); raise Compilation_Error; end if; Set_File (Fe); if not Files_Map.Is_Eq (Files_Map.Get_File_Time_Stamp (Get_Current_Source_File), Get_File_Time_Stamp (Design_File)) then Error_Msg_Sem ("file " & Image (Get_Design_File_Filename (Design_File)) & " has changed and must be reanalysed", Loc); raise Compilation_Error; elsif Get_Date (Design_Unit) = Date_Obsolete then Error_Msg_Sem (''' & Disp_Node (Get_Library_Unit (Design_Unit)) & "' is not anymore in the file", Design_Unit); raise Compilation_Error; end if; 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)); 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. -- Copy node. 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); Set_Context_Items (Design_Unit, Get_Context_Items (Res)); 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, semantize, back-end a design_unit if necessary. procedure Load_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir) is begin 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); Sem_Scopes.Push_Interpretations; Back_End.Finish_Compilation (Design_Unit); Sem_Scopes.Pop_Interpretations; 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 Error_Msg_Sem (Disp_Node (Design_Unit) & " is obsolete", Loc); return; end if; when others => raise Internal_Error; end case; if not Flags.Flag_Elaborate_With_Outdated and then Is_Obsolete (Design_Unit, Loc) then Set_Date (Design_Unit, Date_Obsolete); end if; end Load_Design_Unit; -- Return the declaration of primary unit NAME of LIBRARY. function Find_Primary_Unit (Library: Iir_Library_Declaration; Name: Name_Id) return Iir_Design_Unit is Unit : Iir_Design_Unit; begin Unit := Unit_Hash_Table (Name mod Unit_Hash_Length); while Unit /= Null_Iir loop if Get_Identifier (Unit) = Name and then Get_Library (Get_Design_File (Unit)) = Library then case Get_Kind (Get_Library_Unit (Unit)) is when Iir_Kind_Package_Declaration | Iir_Kind_Package_Instantiation_Declaration | Iir_Kind_Entity_Declaration | Iir_Kind_Configuration_Declaration => -- Only return a primary unit. return Unit; when Iir_Kind_Package_Body | Iir_Kind_Architecture_Body => null; when others => raise Internal_Error; end case; end if; Unit := Get_Hash_Chain (Unit); end loop; -- The primary unit is not in the library, return null. 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) return Iir_Design_Unit is Design_Unit: Iir_Design_Unit; Library_Unit: Iir; Primary_Ident: Name_Id; Lib_Prim : Iir; begin Lib_Prim := Get_Library (Get_Design_File (Primary)); Primary_Ident := Get_Identifier (Get_Library_Unit (Primary)); Design_Unit := Unit_Hash_Table (Primary_Ident mod Unit_Hash_Length); while Design_Unit /= Null_Iir loop Library_Unit := Get_Library_Unit (Design_Unit); -- The secondary is always in the same library as the primary. if Get_Library (Get_Design_File (Design_Unit)) = Lib_Prim then -- Set design_unit to null iff this is not the correct -- design unit. case Get_Kind (Library_Unit) is when Iir_Kind_Architecture_Body => -- The entity field can be either an identifier (if the -- library unit was not loaded) or an access to the entity -- unit. if (Get_Entity_Identifier_Of_Architecture (Library_Unit) = Primary_Ident) and then Get_Identifier (Library_Unit) = Name then return Design_Unit; end if; when Iir_Kind_Package_Body => if Name = Null_Identifier and then Get_Identifier (Library_Unit) = Primary_Ident then return Design_Unit; end if; when others => null; end case; end if; Design_Unit := Get_Hash_Chain (Design_Unit); end loop; -- The architecture or the body is not in the library, return null. 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; Unit : Iir_Design_Unit; begin Unit := Unit_Hash_Table (Name mod Unit_Hash_Length); while Unit /= Null_Iir loop if Get_Identifier (Unit) = Name and then (Get_Kind (Get_Library_Unit (Unit)) = Iir_Kind_Entity_Declaration) then if Res = Null_Iir then Res := Unit; else -- Many entities. return Null_Iir; end if; end if; Unit := Get_Hash_Chain (Unit); end loop; return Res; end Find_Entity_For_Component; function Get_Libraries_Chain return Iir_Library_Declaration is begin return Libraries_Chain; end Get_Libraries_Chain; end Libraries;