From 5c10bacd0cd58926839b8904e10ef0693930bddc Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Mon, 6 May 2019 06:53:37 +0200 Subject: vhdl: move xrefs to vhdl child package. --- src/vhdl/vhdl-parse.adb | 2 +- src/vhdl/vhdl-sem.adb | 2 +- src/vhdl/vhdl-sem_assocs.adb | 4 +- src/vhdl/vhdl-sem_decls.adb | 2 +- src/vhdl/vhdl-sem_expr.adb | 2 +- src/vhdl/vhdl-sem_names.adb | 2 +- src/vhdl/vhdl-sem_psl.adb | 2 +- src/vhdl/vhdl-sem_specs.adb | 2 +- src/vhdl/vhdl-sem_stmts.adb | 2 +- src/vhdl/vhdl-sem_types.adb | 2 +- src/vhdl/vhdl-xrefs.adb | 285 +++++++++++++++++++++++++++++++++++++++++++ src/vhdl/vhdl-xrefs.ads | 115 +++++++++++++++++ src/vhdl/xrefs.adb | 285 ------------------------------------------- src/vhdl/xrefs.ads | 115 ----------------- 14 files changed, 411 insertions(+), 411 deletions(-) create mode 100644 src/vhdl/vhdl-xrefs.adb create mode 100644 src/vhdl/vhdl-xrefs.ads delete mode 100644 src/vhdl/xrefs.adb delete mode 100644 src/vhdl/xrefs.ads (limited to 'src/vhdl') diff --git a/src/vhdl/vhdl-parse.adb b/src/vhdl/vhdl-parse.adb index 4c39d91bb..ac1fa7b94 100644 --- a/src/vhdl/vhdl-parse.adb +++ b/src/vhdl/vhdl-parse.adb @@ -24,7 +24,7 @@ with Std_Names; use Std_Names; with Flags; use Flags; with Vhdl.Parse_Psl; with Str_Table; -with Xrefs; +with Vhdl.Xrefs; with Vhdl.Elocations; use Vhdl.Elocations; -- Recursive descendant parser. diff --git a/src/vhdl/vhdl-sem.adb b/src/vhdl/vhdl-sem.adb index 0af9db861..8cc7f934f 100644 --- a/src/vhdl/vhdl-sem.adb +++ b/src/vhdl/vhdl-sem.adb @@ -34,7 +34,7 @@ with Str_Table; with Vhdl.Sem_Utils; with Vhdl.Sem_Stmts; use Vhdl.Sem_Stmts; with Iir_Chains; -with Xrefs; use Xrefs; +with Vhdl.Xrefs; use Vhdl.Xrefs; package body Vhdl.Sem is -- Forward declarations. diff --git a/src/vhdl/vhdl-sem_assocs.adb b/src/vhdl/vhdl-sem_assocs.adb index 112ed5e2f..b56692a40 100644 --- a/src/vhdl/vhdl-sem_assocs.adb +++ b/src/vhdl/vhdl-sem_assocs.adb @@ -28,7 +28,7 @@ with Vhdl.Sem_Decls; with Vhdl.Std_Package; with Vhdl.Sem_Scopes; with Iir_Chains; use Iir_Chains; -with Xrefs; +with Vhdl.Xrefs; package body Vhdl.Sem_Assocs is function Rewrite_Non_Object_Association (Assoc : Iir; Inter : Iir) @@ -1773,7 +1773,7 @@ package body Vhdl.Sem_Assocs is end case; Set_Named_Entity (Actual, Res); - Xrefs.Xref_Name (Actual); + Vhdl.Xrefs.Xref_Name (Actual); Sem_Decls.Mark_Subprogram_Used (Res); end Sem_Association_Subprogram; diff --git a/src/vhdl/vhdl-sem_decls.adb b/src/vhdl/vhdl-sem_decls.adb index 21eefd8ae..24d07d77f 100644 --- a/src/vhdl/vhdl-sem_decls.adb +++ b/src/vhdl/vhdl-sem_decls.adb @@ -32,7 +32,7 @@ with Vhdl.Sem_Specs; use Vhdl.Sem_Specs; with Vhdl.Sem_Types; use Vhdl.Sem_Types; with Vhdl.Sem_Psl; with Vhdl.Sem_Inst; -with Xrefs; use Xrefs; +with Vhdl.Xrefs; use Vhdl.Xrefs; package body Vhdl.Sem_Decls is -- Region that can declare signals. Used to add implicit declarations. diff --git a/src/vhdl/vhdl-sem_expr.adb b/src/vhdl/vhdl-sem_expr.adb index 5fa584758..91ff0b950 100644 --- a/src/vhdl/vhdl-sem_expr.adb +++ b/src/vhdl/vhdl-sem_expr.adb @@ -32,7 +32,7 @@ with Vhdl.Sem_Types; with Vhdl.Sem_Stmts; use Vhdl.Sem_Stmts; with Vhdl.Sem_Assocs; use Vhdl.Sem_Assocs; with Vhdl.Sem_Decls; -with Xrefs; use Xrefs; +with Vhdl.Xrefs; use Vhdl.Xrefs; package body Vhdl.Sem_Expr is diff --git a/src/vhdl/vhdl-sem_names.adb b/src/vhdl/vhdl-sem_names.adb index afb0b549b..85986cb78 100644 --- a/src/vhdl/vhdl-sem_names.adb +++ b/src/vhdl/vhdl-sem_names.adb @@ -34,7 +34,7 @@ with Vhdl.Sem_Assocs; use Vhdl.Sem_Assocs; with Vhdl.Sem_Specs; with Vhdl.Sem_Types; with Vhdl.Sem_Psl; -with Xrefs; use Xrefs; +with Vhdl.Xrefs; use Vhdl.Xrefs; package body Vhdl.Sem_Names is -- Finish the analyze of NAME using RES as named entity. diff --git a/src/vhdl/vhdl-sem_psl.adb b/src/vhdl/vhdl-sem_psl.adb index a9ca225b2..5d782ed40 100644 --- a/src/vhdl/vhdl-sem_psl.adb +++ b/src/vhdl/vhdl-sem_psl.adb @@ -31,7 +31,7 @@ with Vhdl.Evaluation; use Vhdl.Evaluation; with Vhdl.Std_Package; with Vhdl.Ieee.Std_Logic_1164; with Errorout; use Errorout; -with Xrefs; use Xrefs; +with Vhdl.Xrefs; use Vhdl.Xrefs; package body Vhdl.Sem_Psl is procedure Sem_Psl_Directive_Clock (Stmt : Iir; Prop : in out Node); diff --git a/src/vhdl/vhdl-sem_specs.adb b/src/vhdl/vhdl-sem_specs.adb index aa535017a..5d3224ed0 100644 --- a/src/vhdl/vhdl-sem_specs.adb +++ b/src/vhdl/vhdl-sem_specs.adb @@ -30,7 +30,7 @@ with Iir_Chains; use Iir_Chains; with Flags; use Flags; with Std_Names; with Vhdl.Sem_Decls; -with Xrefs; use Xrefs; +with Vhdl.Xrefs; use Vhdl.Xrefs; with Vhdl.Back_End; package body Vhdl.Sem_Specs is diff --git a/src/vhdl/vhdl-sem_stmts.adb b/src/vhdl/vhdl-sem_stmts.adb index deca231a6..9553dc7df 100644 --- a/src/vhdl/vhdl-sem_stmts.adb +++ b/src/vhdl/vhdl-sem_stmts.adb @@ -30,7 +30,7 @@ with Vhdl.Sem_Psl; with Std_Names; with Vhdl.Evaluation; use Vhdl.Evaluation; with Iirs_Utils; use Iirs_Utils; -with Xrefs; use Xrefs; +with Vhdl.Xrefs; use Vhdl.Xrefs; package body Vhdl.Sem_Stmts is -- Process is the scope, this is also the process for which drivers can diff --git a/src/vhdl/vhdl-sem_types.adb b/src/vhdl/vhdl-sem_types.adb index 3eb5e8fe1..1769bdbfc 100644 --- a/src/vhdl/vhdl-sem_types.adb +++ b/src/vhdl/vhdl-sem_types.adb @@ -31,7 +31,7 @@ with Std_Names; with Iirs_Utils; use Iirs_Utils; with Vhdl.Std_Package; use Vhdl.Std_Package; with Vhdl.Ieee.Std_Logic_1164; -with Xrefs; use Xrefs; +with Vhdl.Xrefs; use Vhdl.Xrefs; package body Vhdl.Sem_Types is -- Mark the resolution function (this may be required by the back-end to diff --git a/src/vhdl/vhdl-xrefs.adb b/src/vhdl/vhdl-xrefs.adb new file mode 100644 index 000000000..021acd485 --- /dev/null +++ b/src/vhdl/vhdl-xrefs.adb @@ -0,0 +1,285 @@ +-- Cross references. +-- 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 Tables; +with GNAT.Heap_Sort_A; +with Flags; +with Vhdl.Std_Package; +with Errorout; use Errorout; +with Vhdl.Nodes_Priv; + +package body Vhdl.Xrefs is + type Xref_Type is record + -- Where the cross-reference (or the name) appears. + Loc : Location_Type; + + -- What the name refer to. + Ref : Iir; + + -- Kind of reference (See package specification). + Kind : Xref_Kind; + end record; + + package Xref_Table is new Tables + (Table_Index_Type => Natural, + Table_Component_Type => Xref_Type, + Table_Low_Bound => 0, + Table_Initial => 128); + + function Get_Xref_Location (N : Xref) return Location_Type is + begin + return Xref_Table.Table (N).Loc; + end Get_Xref_Location; + + function Get_Xref_Kind (N : Xref) return Xref_Kind is + begin + return Xref_Table.Table (N).Kind; + end Get_Xref_Kind; + + function Get_Xref_Node (N : Xref) return Iir is + begin + return Xref_Table.Table (N).Ref; + end Get_Xref_Node; + + function Get_Last_Xref return Xref is + begin + return Xref_Table.Last; + end Get_Last_Xref; + + procedure Init is + begin + Xref_Table.Set_Last (Bad_Xref); + end Init; + + procedure Add_Xref (Loc : Location_Type; Ref : Iir; Kind : Xref_Kind) is + begin + -- Check there is no xref for the same location to the same reference. + -- (Note that a designatore may reference several declarations, this + -- is possible in attribute specification for an overloadable name). + -- This is a simple heuristic as this catch only two referenced in the + -- row but efficient and should be enough to catch errors. + pragma Assert + (Xref_Table.Last < Xref_Table.First + or else Xref_Table.Table (Xref_Table.Last).Loc /= Loc + or else Xref_Table.Table (Xref_Table.Last).Ref /= Ref); + + Xref_Table.Append (Xref_Type'(Loc => Loc, + Ref => Ref, + Kind => Kind)); + end Add_Xref; + + procedure Xref_Decl (Decl : Iir) is + begin + if Flags.Flag_Xref then + Add_Xref (Get_Location (Decl), Decl, Xref_Decl); + end if; + end Xref_Decl; + + procedure Xref_Ref (Name : Iir; Decl : Iir) is + begin + if Flags.Flag_Xref then + Add_Xref (Get_Location (Name), Decl, Xref_Ref); + end if; + end Xref_Ref; + + procedure Xref_Body (Bod : Iir; Spec : Iir) is + begin + if Flags.Flag_Xref then + Add_Xref (Get_Location (Bod), Spec, Xref_Body); + end if; + end Xref_Body; + + procedure Xref_End (Loc : Location_Type; Decl : Iir) is + begin + if Flags.Flag_Xref then + Add_Xref (Loc, Decl, Xref_End); + end if; + end Xref_End; + + procedure Xref_Keyword (Loc : Location_Type) is + begin + if Flags.Flag_Xref then + Add_Xref (Loc, Null_Iir, Xref_Keyword); + end if; + end Xref_Keyword; + + procedure Xref_Name_1 (Name : Iir) is + begin + case Get_Kind (Name) is + when Iir_Kind_Simple_Name + | Iir_Kind_Selected_Name + | Iir_Kind_Operator_Symbol + | Iir_Kind_Character_Literal => + declare + Res : constant Iir := Get_Named_Entity (Name); + begin + if Res = Vhdl.Std_Package.Error_Mark then + return; + end if; + Add_Xref (Get_Location (Name), Res, Xref_Ref); + end; + when Iir_Kind_Selected_Element => + Add_Xref (Get_Location (Name), + Get_Named_Entity (Name), Xref_Ref); + when Iir_Kind_Dereference + | Iir_Kind_Implicit_Dereference + | Iir_Kind_Slice_Name + | Iir_Kind_Indexed_Name + | Iir_Kind_Function_Call => + null; + when Iir_Kinds_Attribute => + null; + when Iir_Kind_Attribute_Name => + -- FIXME: user defined attributes. + null; + when Iir_Kind_Type_Conversion => + return; + when others => + Error_Kind ("xref_name_1", Name); + end case; + case Get_Kind (Name) is + when Iir_Kind_Simple_Name + | Iir_Kind_Operator_Symbol + | Iir_Kind_Character_Literal => + null; + when Iir_Kind_Selected_Name + | Iir_Kind_Selected_Element + | Iir_Kind_Attribute_Name + | Iir_Kind_Slice_Name + | Iir_Kind_Indexed_Name + | Iir_Kind_Dereference + | Iir_Kind_Implicit_Dereference + | Iir_Kinds_Attribute + | Iir_Kind_Function_Call => + Xref_Name_1 (Get_Prefix (Name)); + when others => + Error_Kind ("xref_name_1", Name); + end case; + end Xref_Name_1; + + procedure Xref_Name (Name : Iir) is + begin + if Flags.Flag_Xref and Name /= Null_Iir then + Xref_Name_1 (Name); + end if; + end Xref_Name; + + procedure Move (From : Natural; To : Natural) + is + Tmp : Xref_Type; + begin + Tmp := Xref_Table.Table (To); + Xref_Table.Table (To) := Xref_Table.Table (From); + Xref_Table.Table (From) := Tmp; + end Move; + + function Loc_Lt (Op1, Op2 : Natural) return Boolean + is + L1 : constant Location_Type := Xref_Table.Table (Op1).Loc; + L2 : constant Location_Type := Xref_Table.Table (Op2).Loc; + begin + return L1 < L2; + end Loc_Lt; + + procedure Sort_By_Location is + begin + GNAT.Heap_Sort_A.Sort (Xref_Table.Last, Move'Access, Loc_Lt'Access); + end Sort_By_Location; + + -- Sorting function by ref field. + -- If ref fields are the same, then compare by location. + function Node_Lt (Op1, Op2 : Natural) return Boolean + is + L1, L2 : Location_Type; + N1, N2 : Iir; + K1, K2 : Xref_Kind; + begin + L1 := Get_Location (Get_Xref_Node (Op1)); + L2 := Get_Location (Get_Xref_Node (Op2)); + + if L1 /= L2 then + return L1 < L2; + end if; + + -- L1 = L2. + -- Note: nodes of std_standard have the same location. FIXME ? + N1 := Get_Xref_Node (Op1); + N2 := Get_Xref_Node (Op2); + if Vhdl.Nodes."/=" (N1, N2) then + return Vhdl.Nodes_Priv."<" (N1, N2); + end if; + + -- Try to get declaration first. + K1 := Get_Xref_Kind (Op1); + K2 := Get_Xref_Kind (Op2); + if K1 /= K2 then + return K1 < K2; + end if; + L1 := Get_Xref_Location (Op1); + L2 := Get_Xref_Location (Op2); + return L1 < L2; + end Node_Lt; + + procedure Sort_By_Node_Location is + begin + GNAT.Heap_Sort_A.Sort (Xref_Table.Last, Move'Access, Node_Lt'Access); + end Sort_By_Node_Location; + + function Find (Loc : Location_Type) return Xref + is + Low : Xref; + High : Xref; + Mid : Xref; + Mid_Loc : Location_Type; + begin + Low := First_Xref; + High := Xref_Table.Last; + loop + Mid := (Low + High + 1) / 2; + Mid_Loc := Xref_Table.Table (Mid).Loc; + if Loc = Mid_Loc then + return Mid; + end if; + if Mid = Low then + return Bad_Xref; + end if; + if Loc > Mid_Loc then + Low := Mid + 1; + else + High := Mid - 1; + end if; + end loop; + end Find; + + procedure Fix_End_Xrefs + is + N : Iir; + begin + for I in First_Xref .. Get_Last_Xref loop + if Get_Xref_Kind (I) = Xref_End then + N := Get_Xref_Node (I); + case Get_Kind (N) is + when Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body => + Xref_Table.Table (I).Ref := Get_Subprogram_Specification (N); + when others => + null; + end case; + end if; + end loop; + end Fix_End_Xrefs; +end Vhdl.Xrefs; diff --git a/src/vhdl/vhdl-xrefs.ads b/src/vhdl/vhdl-xrefs.ads new file mode 100644 index 000000000..da990f090 --- /dev/null +++ b/src/vhdl/vhdl-xrefs.ads @@ -0,0 +1,115 @@ +-- Cross references. +-- 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 Types; use Types; +with Vhdl.Nodes; use Vhdl.Nodes; + +package Vhdl.Xrefs is + type Xref_Kind is + ( + -- Declaration of an identifier. + Xref_Decl, + + -- Use of a named entity. + Xref_Ref, + + -- Identifier after the 'end' keyword. + Xref_End, + + -- Body of a declaration (for package, subprograms or protected type). + Xref_Body, + + -- A PSL keyword that would be scanned as an identifier + Xref_Keyword + ); + + -- Initialize the xref table. + -- Must be called once. + procedure Init; + + -- Low level xref addition. + -- An entity at LOC references REF with the KIND way. + procedure Add_Xref (Loc : Location_Type; Ref : Iir; Kind : Xref_Kind); + + -- Add a declaration of an identifier. + -- This is somewhat a self-reference. + procedure Xref_Decl (Decl : Iir); + pragma Inline (Xref_Decl); + + -- NAME refers to DECL. + procedure Xref_Ref (Name : Iir; Decl : Iir); + pragma Inline (Xref_Ref); + + -- BODy refers to SPEC. + procedure Xref_Body (Bod : Iir; Spec : Iir); + pragma Inline (Xref_Body); + + -- Just resolved NAME refers to its named entity. + procedure Xref_Name (Name : Iir); + pragma Inline (Xref_Name); + + -- LOC is the location of the simple_name after 'end' for DECL. + procedure Xref_End (Loc : Location_Type; Decl : Iir); + pragma Inline (Xref_End); + + -- LOC is the location of a PSL keyword. + procedure Xref_Keyword (Loc : Location_Type); + pragma Inline (Xref_Keyword); + + -- Sort the xref table by location. This is required before searching with + -- Find. + procedure Sort_By_Location; + + -- Sort the xref table by location of the nodes. + procedure Sort_By_Node_Location; + + subtype Xref is Natural; + + -- A bad xref. + -- May be returned by Find. + Bad_Xref : constant Xref := 0; + + -- First xref. + -- May be used to size a table. + First_Xref : constant Xref := 1; + + -- Find a reference by location. + -- The table must already be sorted with Sort_By_Location. + -- Returns BAD_REF is does not exist. + function Find (Loc : Location_Type) return Xref; + + -- End_Xrefs are added by parse and points to the subprogram_body. + -- This procedure make them points to the subprogram_decl node. + -- This is done so that every node has a name. + procedure Fix_End_Xrefs; + + -- Get the last possible xref available. + -- May be used to size tables. + function Get_Last_Xref return Xref; + + -- Get the location of N, ie where a name (or operator) appears. + function Get_Xref_Location (N : Xref) return Location_Type; + pragma Inline (Get_Xref_Location); + + -- Get the kind of cross-reference. + function Get_Xref_Kind (N : Xref) return Xref_Kind; + pragma Inline (Get_Xref_Kind); + + -- Get the node referenced by the name. + function Get_Xref_Node (N : Xref) return Iir; + pragma Inline (Get_Xref_Node); +end Vhdl.Xrefs; diff --git a/src/vhdl/xrefs.adb b/src/vhdl/xrefs.adb deleted file mode 100644 index 0c510892b..000000000 --- a/src/vhdl/xrefs.adb +++ /dev/null @@ -1,285 +0,0 @@ --- Cross references. --- 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 Tables; -with GNAT.Heap_Sort_A; -with Flags; -with Vhdl.Std_Package; -with Errorout; use Errorout; -with Vhdl.Nodes_Priv; - -package body Xrefs is - type Xref_Type is record - -- Where the cross-reference (or the name) appears. - Loc : Location_Type; - - -- What the name refer to. - Ref : Iir; - - -- Kind of reference (See package specification). - Kind : Xref_Kind; - end record; - - package Xref_Table is new Tables - (Table_Index_Type => Natural, - Table_Component_Type => Xref_Type, - Table_Low_Bound => 0, - Table_Initial => 128); - - function Get_Xref_Location (N : Xref) return Location_Type is - begin - return Xref_Table.Table (N).Loc; - end Get_Xref_Location; - - function Get_Xref_Kind (N : Xref) return Xref_Kind is - begin - return Xref_Table.Table (N).Kind; - end Get_Xref_Kind; - - function Get_Xref_Node (N : Xref) return Iir is - begin - return Xref_Table.Table (N).Ref; - end Get_Xref_Node; - - function Get_Last_Xref return Xref is - begin - return Xref_Table.Last; - end Get_Last_Xref; - - procedure Init is - begin - Xref_Table.Set_Last (Bad_Xref); - end Init; - - procedure Add_Xref (Loc : Location_Type; Ref : Iir; Kind : Xref_Kind) is - begin - -- Check there is no xref for the same location to the same reference. - -- (Note that a designatore may reference several declarations, this - -- is possible in attribute specification for an overloadable name). - -- This is a simple heuristic as this catch only two referenced in the - -- row but efficient and should be enough to catch errors. - pragma Assert - (Xref_Table.Last < Xref_Table.First - or else Xref_Table.Table (Xref_Table.Last).Loc /= Loc - or else Xref_Table.Table (Xref_Table.Last).Ref /= Ref); - - Xref_Table.Append (Xref_Type'(Loc => Loc, - Ref => Ref, - Kind => Kind)); - end Add_Xref; - - procedure Xref_Decl (Decl : Iir) is - begin - if Flags.Flag_Xref then - Add_Xref (Get_Location (Decl), Decl, Xref_Decl); - end if; - end Xref_Decl; - - procedure Xref_Ref (Name : Iir; Decl : Iir) is - begin - if Flags.Flag_Xref then - Add_Xref (Get_Location (Name), Decl, Xref_Ref); - end if; - end Xref_Ref; - - procedure Xref_Body (Bod : Iir; Spec : Iir) is - begin - if Flags.Flag_Xref then - Add_Xref (Get_Location (Bod), Spec, Xref_Body); - end if; - end Xref_Body; - - procedure Xref_End (Loc : Location_Type; Decl : Iir) is - begin - if Flags.Flag_Xref then - Add_Xref (Loc, Decl, Xref_End); - end if; - end Xref_End; - - procedure Xref_Keyword (Loc : Location_Type) is - begin - if Flags.Flag_Xref then - Add_Xref (Loc, Null_Iir, Xref_Keyword); - end if; - end Xref_Keyword; - - procedure Xref_Name_1 (Name : Iir) is - begin - case Get_Kind (Name) is - when Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name - | Iir_Kind_Operator_Symbol - | Iir_Kind_Character_Literal => - declare - Res : constant Iir := Get_Named_Entity (Name); - begin - if Res = Vhdl.Std_Package.Error_Mark then - return; - end if; - Add_Xref (Get_Location (Name), Res, Xref_Ref); - end; - when Iir_Kind_Selected_Element => - Add_Xref (Get_Location (Name), - Get_Named_Entity (Name), Xref_Ref); - when Iir_Kind_Dereference - | Iir_Kind_Implicit_Dereference - | Iir_Kind_Slice_Name - | Iir_Kind_Indexed_Name - | Iir_Kind_Function_Call => - null; - when Iir_Kinds_Attribute => - null; - when Iir_Kind_Attribute_Name => - -- FIXME: user defined attributes. - null; - when Iir_Kind_Type_Conversion => - return; - when others => - Error_Kind ("xref_name_1", Name); - end case; - case Get_Kind (Name) is - when Iir_Kind_Simple_Name - | Iir_Kind_Operator_Symbol - | Iir_Kind_Character_Literal => - null; - when Iir_Kind_Selected_Name - | Iir_Kind_Selected_Element - | Iir_Kind_Attribute_Name - | Iir_Kind_Slice_Name - | Iir_Kind_Indexed_Name - | Iir_Kind_Dereference - | Iir_Kind_Implicit_Dereference - | Iir_Kinds_Attribute - | Iir_Kind_Function_Call => - Xref_Name_1 (Get_Prefix (Name)); - when others => - Error_Kind ("xref_name_1", Name); - end case; - end Xref_Name_1; - - procedure Xref_Name (Name : Iir) is - begin - if Flags.Flag_Xref and Name /= Null_Iir then - Xref_Name_1 (Name); - end if; - end Xref_Name; - - procedure Move (From : Natural; To : Natural) - is - Tmp : Xref_Type; - begin - Tmp := Xref_Table.Table (To); - Xref_Table.Table (To) := Xref_Table.Table (From); - Xref_Table.Table (From) := Tmp; - end Move; - - function Loc_Lt (Op1, Op2 : Natural) return Boolean - is - L1 : constant Location_Type := Xref_Table.Table (Op1).Loc; - L2 : constant Location_Type := Xref_Table.Table (Op2).Loc; - begin - return L1 < L2; - end Loc_Lt; - - procedure Sort_By_Location is - begin - GNAT.Heap_Sort_A.Sort (Xref_Table.Last, Move'Access, Loc_Lt'Access); - end Sort_By_Location; - - -- Sorting function by ref field. - -- If ref fields are the same, then compare by location. - function Node_Lt (Op1, Op2 : Natural) return Boolean - is - L1, L2 : Location_Type; - N1, N2 : Iir; - K1, K2 : Xref_Kind; - begin - L1 := Get_Location (Get_Xref_Node (Op1)); - L2 := Get_Location (Get_Xref_Node (Op2)); - - if L1 /= L2 then - return L1 < L2; - end if; - - -- L1 = L2. - -- Note: nodes of std_standard have the same location. FIXME ? - N1 := Get_Xref_Node (Op1); - N2 := Get_Xref_Node (Op2); - if Vhdl.Nodes."/=" (N1, N2) then - return Vhdl.Nodes_Priv."<" (N1, N2); - end if; - - -- Try to get declaration first. - K1 := Get_Xref_Kind (Op1); - K2 := Get_Xref_Kind (Op2); - if K1 /= K2 then - return K1 < K2; - end if; - L1 := Get_Xref_Location (Op1); - L2 := Get_Xref_Location (Op2); - return L1 < L2; - end Node_Lt; - - procedure Sort_By_Node_Location is - begin - GNAT.Heap_Sort_A.Sort (Xref_Table.Last, Move'Access, Node_Lt'Access); - end Sort_By_Node_Location; - - function Find (Loc : Location_Type) return Xref - is - Low : Xref; - High : Xref; - Mid : Xref; - Mid_Loc : Location_Type; - begin - Low := First_Xref; - High := Xref_Table.Last; - loop - Mid := (Low + High + 1) / 2; - Mid_Loc := Xref_Table.Table (Mid).Loc; - if Loc = Mid_Loc then - return Mid; - end if; - if Mid = Low then - return Bad_Xref; - end if; - if Loc > Mid_Loc then - Low := Mid + 1; - else - High := Mid - 1; - end if; - end loop; - end Find; - - procedure Fix_End_Xrefs - is - N : Iir; - begin - for I in First_Xref .. Get_Last_Xref loop - if Get_Xref_Kind (I) = Xref_End then - N := Get_Xref_Node (I); - case Get_Kind (N) is - when Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body => - Xref_Table.Table (I).Ref := Get_Subprogram_Specification (N); - when others => - null; - end case; - end if; - end loop; - end Fix_End_Xrefs; -end Xrefs; diff --git a/src/vhdl/xrefs.ads b/src/vhdl/xrefs.ads deleted file mode 100644 index 766d123c1..000000000 --- a/src/vhdl/xrefs.ads +++ /dev/null @@ -1,115 +0,0 @@ --- Cross references. --- 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 Types; use Types; -with Vhdl.Nodes; use Vhdl.Nodes; - -package Xrefs is - type Xref_Kind is - ( - -- Declaration of an identifier. - Xref_Decl, - - -- Use of a named entity. - Xref_Ref, - - -- Identifier after the 'end' keyword. - Xref_End, - - -- Body of a declaration (for package, subprograms or protected type). - Xref_Body, - - -- A PSL keyword that would be scanned as an identifier - Xref_Keyword - ); - - -- Initialize the xref table. - -- Must be called once. - procedure Init; - - -- Low level xref addition. - -- An entity at LOC references REF with the KIND way. - procedure Add_Xref (Loc : Location_Type; Ref : Iir; Kind : Xref_Kind); - - -- Add a declaration of an identifier. - -- This is somewhat a self-reference. - procedure Xref_Decl (Decl : Iir); - pragma Inline (Xref_Decl); - - -- NAME refers to DECL. - procedure Xref_Ref (Name : Iir; Decl : Iir); - pragma Inline (Xref_Ref); - - -- BODy refers to SPEC. - procedure Xref_Body (Bod : Iir; Spec : Iir); - pragma Inline (Xref_Body); - - -- Just resolved NAME refers to its named entity. - procedure Xref_Name (Name : Iir); - pragma Inline (Xref_Name); - - -- LOC is the location of the simple_name after 'end' for DECL. - procedure Xref_End (Loc : Location_Type; Decl : Iir); - pragma Inline (Xref_End); - - -- LOC is the location of a PSL keyword. - procedure Xref_Keyword (Loc : Location_Type); - pragma Inline (Xref_Keyword); - - -- Sort the xref table by location. This is required before searching with - -- Find. - procedure Sort_By_Location; - - -- Sort the xref table by location of the nodes. - procedure Sort_By_Node_Location; - - subtype Xref is Natural; - - -- A bad xref. - -- May be returned by Find. - Bad_Xref : constant Xref := 0; - - -- First xref. - -- May be used to size a table. - First_Xref : constant Xref := 1; - - -- Find a reference by location. - -- The table must already be sorted with Sort_By_Location. - -- Returns BAD_REF is does not exist. - function Find (Loc : Location_Type) return Xref; - - -- End_Xrefs are added by parse and points to the subprogram_body. - -- This procedure make them points to the subprogram_decl node. - -- This is done so that every node has a name. - procedure Fix_End_Xrefs; - - -- Get the last possible xref available. - -- May be used to size tables. - function Get_Last_Xref return Xref; - - -- Get the location of N, ie where a name (or operator) appears. - function Get_Xref_Location (N : Xref) return Location_Type; - pragma Inline (Get_Xref_Location); - - -- Get the kind of cross-reference. - function Get_Xref_Kind (N : Xref) return Xref_Kind; - pragma Inline (Get_Xref_Kind); - - -- Get the node referenced by the name. - function Get_Xref_Node (N : Xref) return Iir; - pragma Inline (Get_Xref_Node); -end Xrefs; -- cgit v1.2.3