-- 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 Interfaces.C_Streams; with System; with GNAT.OS_Lib; with Logging; use Logging; with Tables; with Errorout; use Errorout; with Options; use Options; with Vhdl.Errors; use Vhdl.Errors; with Vhdl.Scanner; with Vhdl.Utils; use Vhdl.Utils; with Name_Table; use Name_Table; with Str_Table; with Vhdl.Tokens; with Files_Map; with Flags; with Vhdl.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; -- Last design_file used. Kept to speed-up operations. Last_Design_File : Iir_Design_File := Null_Iir; -- Table of library paths. package Paths is new Tables (Table_Index_Type => Integer, Table_Component_Type => Name_Id, Table_Low_Bound => 1, Table_Initial => 4); -- Report an error message. procedure Error_Lib_Msg (Msg : String) is begin Report_Msg (Msgid_Error, Library, No_Source_Coord, Msg); end Error_Lib_Msg; -- Initialize paths table. -- Set the local path. procedure Init_Paths is begin -- Always look in current directory first. Name_Nil := Get_Identifier (""); Paths.Append (Name_Nil); Local_Directory := Name_Nil; Work_Directory := Name_Nil; end Init_Paths; 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; Paths.Append (Path_To_Id (Path)); end Add_Library_Path; function Get_Nbr_Paths return Natural is begin return Paths.Last; end Get_Nbr_Paths; function Get_Path (N : Natural) return Name_Id is begin if N not in Paths.First .. Paths.Last then raise Constraint_Error; end if; return Paths.Table (N); end Get_Path; -- Transform a library identifier into a file name. -- Very simple mechanism: just add '-objVV.cf' extension, where VV -- is the version. function Library_To_File_Name (Library: Iir_Library_Declaration) return String is use Flags; begin case Vhdl_Std is when Vhdl_87 => return Image_Identifier (Library) & "-obj87.cf"; when Vhdl_93c | Vhdl_93 | Vhdl_00 | Vhdl_02 => return Image_Identifier (Library) & "-obj93.cf"; when Vhdl_08 => return Image_Identifier (Library) & "-obj08.cf"; end case; end Library_To_File_Name; -- Search LIBRARY in the library path. procedure Search_Library_In_Path (Library : Iir) is use Flags; File_Name : constant String := Library_To_File_Name (Library); Library_Id : constant Name_Id := Get_Identifier (Library); Id_Len : constant Natural := Get_Name_Length (Library_Id); begin for I in Paths.First .. Paths.Last loop -- Try PATH/LIBxxx.cf declare Path : constant String := Image (Paths.Table (I)) & File_Name & ASCII.NUL; begin if GNAT.OS_Lib.Is_Regular_File (Path'Address) then Set_Library_Directory (Library, Paths.Table (I)); exit; end if; end; -- Try PATH/LIB/vNN/LIBxxx.cf declare Pfx : constant String := Image (Paths.Table (I)); Pfx_Len : constant Natural := Pfx'Length; L : Natural; Path : String (1 .. Pfx_Len + Id_Len + 5 + File_Name'Length + 1); begin L := Pfx_Len; Path (1 .. L) := Pfx; Path (L + 1 .. L + Id_Len) := Image (Library_Id); L := L + Id_Len; Path (L + 1) := GNAT.OS_Lib.Directory_Separator; case Vhdl_Std is when Vhdl_87 => Path (L + 2 .. L + 4) := "v87"; when Vhdl_93c | Vhdl_93 | Vhdl_00 | Vhdl_02 => Path (L + 2 .. L + 4) := "v93"; when Vhdl_08 => Path (L + 2 .. L + 4) := "v08"; end case; L := L + 5; Path (L) := GNAT.OS_Lib.Directory_Separator; Path (L + 1 .. L + File_Name'Length) := File_Name; Path (L + File_Name'Length + 1) := Character'Val (0); if GNAT.OS_Lib.Is_Regular_File (Path'Address) then -- For Get_Identifier: keep only the path part (including the -- trailing path separator). Set_Library_Directory (Library, Get_Identifier (Path (1 .. L))); exit; end if; end; end loop; end Search_Library_In_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)) and then Is_Warning_Enabled (Warnid_Library) then -- This is a warning, since 'clean' action should not fail in -- this cases. Warning_Msg_Option (Warnid_Library, "directory '" & Path & "' set by --workdir= does not exist"); -- raise Option_Error; end if; end Set_Work_Library_Path; -- 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 Iir_Kinds_Library_Unit (Get_Kind (Lib_Unit)) is
/*
    ChibiOS - Copyright (C) 2006..2016 Giovanni Di Sirio

    Licensed under the Apache License, Version 2.0 (the "License");
    you may not use this file except in compliance with the License.
    You may obtain a copy of the License at

        http://www.apache.org/licenses/LICENSE-2.0

    Unless required by applicable law or agreed to in writing, software
    distributed under the License is distributed on an "AS IS" BASIS,
    WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
    See the License for the specific language governing permissions and
    limitations under the License.
*/

/**
 * @file    hal_wdg.c
 * @brief   WDG Driver code.
 *
 * @addtogroup WDG
 * @{
 */

#include "hal.h"

#if (HAL_USE_WDG == TRUE) || defined(__DOXYGEN__)

/*===========================================================================*/
/* Driver local definitions.                                                 */
/*===========================================================================*/

/*===========================================================================*/
/* Driver exported variables.                                                */
/*===========================================================================*/

/*===========================================================================*/
/* Driver local variables.                                                   */
/*===========================================================================*/

/*===========================================================================*/
/* Driver local functions.                                                   */
/*===========================================================================*/

/*===========================================================================*/
/* Driver exported functions.                                                */
/*===========================================================================*/

/**
 * @brief   WDG Driver initialization.
 * @note    This function is implicitly invoked by @p halInit(), there is
 *          no need to explicitly initialize the driver.
 *
 * @init
 */
void wdgInit(void) {
    
  wdg_lld_init();
}

/**
 * @brief   Configures and activates the WDG peripheral.
 *
 * @param[in] wdgp      pointer to the @p WDGDriver object
 * @param[in] config    pointer to the @p WDGConfig object
 *
 * @api
 */
void wdgStart(WDGDriver *wdgp, const WDGConfig *config) {

  osalDbgCheck((wdgp != NULL) && (config != NULL));

  osalSysLock();
  osalDbgAssert((wdgp->state == WDG_STOP) || (wdgp->state == WDG_READY),
                "invalid state");
  wdgp->config = config;
  wdg_lld_start(wdgp);
  wdgp->state = WDG_READY;
  osalSysUnlock();
}

/**
 * @brief   Deactivates the WDG peripheral.
 *
 * @param[in] wdgp      pointer to the @p WDGDriver object
 *
 * @api
 */
void wdgStop(WDGDriver *wdgp) {

  osalDbgCheck(wdgp != NULL);

  osalSysLock();
  osalDbgAssert((wdgp->state == WDG_STOP) || (wdgp->state == WDG_READY),
                "invalid state");
  wdg_lld_stop(wdgp);
  wdgp->state = WDG_STOP;
  osalSysUnlock();
}

/**
 * @brief   Resets WDG's counter.
 *
 * @param[in] wdgp      pointer to the @p WDGDriver object
 *
 * @api
 */
void wdgReset(WDGDriver *wdgp) {

  osalDbgCheck(wdgp != NULL);

  osalSysLock();
  osalDbgAssert(wdgp->state == WDG_READY, "not ready");
  wdgResetI(wdgp);
  osalSysUnlock();
}

#endif /* HAL_USE_WDG == TRUE */

/** @} */
try; begin Library_Source_File := Create_Virtual_Source_File (Get_Identifier ("*libraries*")); Command_Source_File := Create_Virtual_Source_File (Get_Identifier ("*command line*")); Command_Line_Location := File_To_Location (Command_Source_File); Library_Location := File_To_Location (Library_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 Vhdl.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; Vhdl.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, Library_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"); raise Option_Error; 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_Location (Std_Library, Get_Location (Standard_Package)); 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"); raise Option_Error; end if; Work_Library := Std_Library; else -- If the library is already known, just switch to it. This is used -- for --work= option in the middle of files. Work_Library := Vhdl.Utils.Find_Name_In_Chain (Libraries_Chain, Work_Library_Name); if Work_Library /= Null_Iir then return; end if; Work_Library := Create_Iir (Iir_Kind_Library_Declaration); Set_Location (Work_Library, Library_Location); 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; else Set_Date (Work_Library, Date_Valid'First); 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; function Get_Library_No_Create (Ident : Name_Id) return Iir_Library_Declaration is begin -- The library work is a little bit special. if Ident = Std_Names.Name_Work or else Ident = Work_Library_Name then -- load_work_library must have been called before. pragma Assert (Work_Library /= Null_Iir); return Work_Library; end if; -- Check if the library has already been loaded. return Vhdl.Utils.Find_Name_In_Chain (Libraries_Chain, Ident); end Get_Library_No_Create; -- 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 := Get_Library_No_Create (Ident); if Library /= Null_Iir then return Library; end if; -- This is a new library. -- Load_std_library must have been called before. pragma Assert (Ident /= Std_Names.Name_Std); Library := Create_Iir (Iir_Kind_Library_Declaration); Set_Location (Library, Library_Location); Set_Library_Directory (Library, Null_Identifier); Set_Identifier (Library, Ident); if Load_Library (Library) = False then Error_Msg_Sem (+Loc, "cannot find resource library %i", +Ident); 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 UNIT1 and UNIT2 have identifiers for the same -- design unit identifier. -- eg: 'entity A' and 'package A' returns TRUE. function Is_Same_Library_Unit (Unit1, Unit2 : Iir) return Boolean is Entity_Name1, Entity_Name2: Name_Id; Unit1_Kind, Unit2_Kind : Iir_Kind; begin if Get_Identifier (Unit1) /= Get_Identifier (Unit2) then return False; end if; Unit1_Kind := Get_Kind (Unit1); Unit2_Kind := Get_Kind (Unit2); -- Package and package body are never the same library unit. if Unit1_Kind = Iir_Kind_Package_Declaration and then Unit2_Kind = Iir_Kind_Package_Body then return False; end if; if Unit2_Kind = Iir_Kind_Package_Declaration and then Unit1_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 Unit1_Kind = Iir_Kind_Architecture_Body and then Unit2_Kind = Iir_Kind_Architecture_Body then Entity_Name1 := Get_Entity_Identifier_Of_Architecture (Unit1); Entity_Name2 := Get_Entity_Identifier_Of_Architecture (Unit2); 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 (Unit1_Kind = Iir_Kind_Architecture_Body and then Unit2_Kind /= Iir_Kind_Architecture_Body) or else (Unit1_Kind /= Iir_Kind_Architecture_Body and then Unit2_Kind = Iir_Kind_Architecture_Body) then return False; end if; return True; end Is_Same_Library_Unit; -- Return true iff DEP (an element of a dependence list) is design unit -- UNIT. function Is_Design_Unit (Dep : Iir; Unit : Iir) return Boolean is Lib_Unit : Iir; begin case Get_Kind (Dep) is when Iir_Kind_Design_Unit => return Dep = Unit; when Iir_Kind_Selected_Name => declare Lib : constant Iir := Get_Library (Get_Design_File (Unit)); begin if Get_Identifier (Get_Prefix (Dep)) /= Get_Identifier (Lib) then return False; end if; end; Lib_Unit := Get_Library_Unit (Unit); case Iir_Kinds_Library_Unit (Get_Kind (Lib_Unit)) is when Iir_Kinds_Primary_Unit | Iir_Kind_Package_Body => return Get_Identifier (Dep) = Get_Identifier (Lib_Unit); when Iir_Kind_Architecture_Body => return False; end case; when Iir_Kind_Entity_Aspect_Entity => Lib_Unit := Get_Library_Unit (Unit); if Get_Kind (Lib_Unit) /= Iir_Kind_Architecture_Body then return False; end if; if Get_Identifier (Get_Architecture (Dep)) /= Get_Identifier (Lib_Unit) then return False; end if; if Get_Entity (Dep) /= Get_Entity (Lib_Unit) then return False; end if; return True; when others => Error_Kind ("is_design_unit", Dep); end case; end Is_Design_Unit; 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 Find_Design_File (Lib : Iir_Library_Declaration; Name : Name_Id) return Iir is File : Iir; begin File := Get_Design_File_Chain (Lib); while Is_Valid (File) loop if Get_Design_File_Filename (File) = Name then return File; end if; File := Get_Chain (File); end loop; return Null_Iir; end Find_Design_File; -- Mark UNIT as obsolete. Mark all units that depends on UNIT as -- obsolete. procedure Mark_Unit_Obsolete (Unit : Iir_Design_Unit) is Lib, File, Un : Iir; List : Iir_List; It : List_Iterator; El : Iir; begin Set_Date (Unit, Date_Obsolete); Lib := Libraries_Chain; while Is_Valid (Lib) loop File := Get_Design_File_Chain (Lib); while Is_Valid (File) loop Un := Get_First_Design_Unit (File); while Is_Valid (Un) loop List := Get_Dependence_List (Un); if List /= Null_Iir_List and then Get_Date (Un) /= Date_Obsolete then pragma Assert (Get_Date_State (Un) = Date_Analyze); It := List_Iterate (List); while Is_Valid (It) loop El := Get_Element (It); if Is_Design_Unit (El, Unit) then -- Keep direct reference (for speed-up). if Get_Kind (El) /= Iir_Kind_Design_Unit then Vhdl.Utils.Free_Recursive (El); Set_Element (It, Unit); end if; -- Recurse. Mark_Unit_Obsolete (Un); end if; Next (It); end loop; end if; Un := Get_Chain (Un); end loop; File := Get_Chain (File); end loop; Lib := Get_Chain (Lib); end loop; end Mark_Unit_Obsolete; -- 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, -- because 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; -- 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_Checksum : File_Checksum_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 : constant Source_File_Entry := Get_Design_File_Source (Get_Design_File (Unit)); begin New_Lib_Checksum := Files_Map.Get_File_Checksum (File); File_Name := Files_Map.Get_File_Name (File); if GNAT.OS_Lib.Is_Absolute_Path (Image (File_Name)) then Dir_Name := Null_Identifier; else Dir_Name := Files_Map.Get_Home_Directory; end if; end; if Unit_Id = Null_Identifier then pragma Assert (Flags.Flag_Force_Analysis); return; end if; -- 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. Mark_Unit_Obsolete (Design_Unit); -- Remove the old one from the hash table. 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; end; -- 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); -- Put removed units in a list so that they are still -- referenced. Set_Chain (Design_Unit, Obsoleted_Design_Units); Obsoleted_Design_Units := Design_Unit; end if; -- 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 Is_Warning_Enabled (Warnid_Library) then Warning_Msg_Sem (Warnid_Library, +Unit, "redefinition of a library unit in " & "same design file:"); Warning_Msg_Sem (Warnid_Library, +Unit, "%n defined at %l is now %n", (+Library_Unit, +Library_Unit, +New_Library_Unit)); end if; else -- Free the stub corresponding to the unit. This is the -- common case when a unit is reanalyzed after a change. 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 Is_Warning_Enabled (Warnid_Library) then if Get_Kind (Library_Unit) /= Get_Kind (New_Library_Unit) then Warning_Msg_Sem (Warnid_Library, +Unit, "changing definition of a library unit:"); Warning_Msg_Sem (Warnid_Library, +Unit, "%n is now %n", (+Library_Unit, +New_Library_Unit)); end if; Warning_Msg_Sem (Warnid_Library, +Unit, "%n was also defined in file %i", (+Library_Unit, +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 New_Lib_Checksum /= No_File_Checksum_Id and then not Files_Map.Is_Eq (New_Lib_Checksum, Get_File_Checksum (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_Checksum (Design_File, New_Lib_Checksum); 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. Mark_Unit_Obsolete (Design_Unit); Remove_Unit_Hash (Design_Unit); else raise Internal_Error; end if; Prev_Design_Unit := Design_Unit; Design_Unit := Get_Chain (Design_Unit); -- Put it on the obsolete list so that it is always referenced. 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_Checksum (Design_File, New_Lib_Checksum); 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 pragma Assert (Get_First_Design_Unit (Design_File) = Null_Iir); Set_First_Design_Unit (Design_File, Unit); else pragma Assert (Get_First_Design_Unit (Design_File) /= Null_Iir); 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) & '_' & 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_Lib_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_Lib_Msg ("cannot create library file for " & Image_Identifier (Library)); raise Option_Error; end if; -- Header: version. WR ("v 4"); 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 = Vhdl.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 WR (""""); WR (Image (Dir)); WR (""""); end if; WR (" """); WR (Image (Get_Design_File_Filename (Design_File))); WR (""" """); WR (Files_Map.Get_File_Checksum_String (Get_File_Checksum (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 Iir_Kind_Context_Declaration => WR ("context "); WR (Image_Identifier (Library_Unit)); when Iir_Kind_Vunit_Declaration => WR ("vunit "); WR (Image_Identifier (Library_Unit)); when Iir_Kind_Vprop_Declaration => WR ("vprop "); WR (Image_Identifier (Library_Unit)); when Iir_Kind_Vmode_Declaration => WR ("vmode "); 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"); WR (Date_Type'Image (Get_Date (Design_Unit))); case Get_Date (Design_Unit) is when Date_Valid | Date_Obsolete | Date_Analyzed | Date_Parsed => null; when others => 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 File_Name: constant String := Image (Work_Directory) & 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_Lib_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; -- 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 Iir_Kinds_Library_Unit (Get_Kind (Get_Library_Unit (Unit))) is when Iir_Kinds_Primary_Unit => -- Only return a primary unit. return Unit; when Iir_Kinds_Secondary_Unit => null; 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; -- 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 Lib_Prim : constant Iir := Get_Library (Get_Design_File (Primary)); Primary_Ident : constant Name_Id := Get_Identifier (Get_Library_Unit (Primary)); Design_Unit: Iir_Design_Unit; Library_Unit: Iir; begin 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; 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; function Decode_Work_Option (Opt : String) return Boolean is pragma Assert (Opt'First = 1); Name : String (1 .. Opt'Last - 8 + 1); Err : Boolean; begin Name := Opt (8 .. Opt'Last); Vhdl.Scanner.Convert_Identifier (Name, Err); if Err then return False; end if; Libraries.Work_Library_Name := Get_Identifier (Name); return True; end Decode_Work_Option; end Libraries;