diff options
Diffstat (limited to 'src/vhdl/vhdl-elocations.adb.in')
| -rw-r--r-- | src/vhdl/vhdl-elocations.adb.in | 188 |
1 files changed, 188 insertions, 0 deletions
diff --git a/src/vhdl/vhdl-elocations.adb.in b/src/vhdl/vhdl-elocations.adb.in new file mode 100644 index 000000000..1e2827b5f --- /dev/null +++ b/src/vhdl/vhdl-elocations.adb.in @@ -0,0 +1,188 @@ +-- Extended locations for iir nodes +-- Copyright (C) 2017 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 Nodes; +with Vhdl.Elocations_Meta; use Vhdl.Elocations_Meta; + +package body Vhdl.Elocations is + + -- Format of a node. + type Format_Type is + ( + Format_None, + Format_L1, + Format_L2, + Format_L3, + Format_L4, + Format_L5, + Format_L6 + ); + + -- Common fields are: + + -- Fields of Format_None: + + -- Fields of Format_L1: + -- Field1 : Location_Type + + -- Fields of Format_L2: + -- Field1 : Location_Type + -- Field2 : Location_Type + + -- Fields of Format_L3: + -- Field1 : Location_Type + -- Field2 : Location_Type + -- Field3 : Location_Type + + -- Fields of Format_L4: + -- Field1 : Location_Type + -- Field2 : Location_Type + -- Field3 : Location_Type + -- Field4 : Location_Type + + -- Fields of Format_L5: + -- Field1 : Location_Type + -- Field2 : Location_Type + -- Field3 : Location_Type + -- Field4 : Location_Type + -- Field5 : Location_Type + + -- Fields of Format_L6: + -- Field1 : Location_Type + -- Field2 : Location_Type + -- Field3 : Location_Type + -- Field4 : Location_Type + -- Field5 : Location_Type + -- Field6 : Location_Type + + function Get_Format (Kind : Iir_Kind) return Format_Type; + + type Location_Index_Type is new Types.Nat32; + No_Location_Index : constant Location_Index_Type := 0; + + package Elocations_Index_Table is new Tables + (Table_Component_Type => Location_Index_Type, + Table_Index_Type => Iir, + Table_Low_Bound => 2, + Table_Initial => 1024); + + package Elocations_Table is new Tables + (Table_Component_Type => Location_Type, + Table_Index_Type => Location_Index_Type, + Table_Low_Bound => 2, + Table_Initial => 1024); + + procedure Create_Elocations (N : Iir) + is + use Nodes; + Format : constant Format_Type := Get_Format (Get_Kind (N)); + El : constant Iir := Elocations_Index_Table.Last; + Len : Location_Index_Type; + Idx : Location_Index_Type; + begin + pragma Assert (Format /= Format_None); + + if El < N then + Elocations_Index_Table.Set_Last (N); + Elocations_Index_Table.Table (El + 1 .. N) := + (others => No_Location_Index); + end if; + + -- Must be called once. + pragma Assert (Elocations_Index_Table.Table (N) = No_Location_Index); + + case Format is + when Format_None => + raise Program_Error; + when Format_L1 => + Len := 1; + when Format_L2 => + Len := 2; + when Format_L3 => + Len := 3; + when Format_L4 => + Len := 4; + when Format_L5 => + Len := 5; + when Format_L6 => + Len := 6; + end case; + + Idx := Elocations_Table.Last + 1; + Elocations_Index_Table.Table (N) := Idx; + Elocations_Table.Set_Last (Idx + Len - 1); + Elocations_Table.Table (Idx .. Idx + Len - 1) := (others => No_Location); + end Create_Elocations; + + procedure Delete_Elocations (N : Iir) is + begin + -- Clear the corresponding index. + Elocations_Index_Table.Table (N) := No_Location_Index; + + -- FIXME: keep free slots in chained list ? + end Delete_Elocations; + + generic + Off : Location_Index_Type; + function Get_FieldX (N : Iir) return Location_Type; + + generic + Off : Location_Index_Type; + procedure Set_FieldX (N : Iir; Loc : Location_Type); + + function Get_FieldX (N : Iir) return Location_Type + is + use Nodes; + Idx : Location_Index_Type; + begin + pragma Assert (N <= Elocations_Index_Table.Last); + Idx := Elocations_Index_Table.Table (N); + return Elocations_Table.Table (Idx + Off - 1); + end Get_FieldX; + + procedure Set_FieldX (N : Iir; Loc : Location_Type) + is + use Nodes; + Idx : Location_Index_Type; + begin + pragma Assert (N <= Elocations_Index_Table.Last); + Idx := Elocations_Index_Table.Table (N); + Elocations_Table.Table (Idx + Off - 1) := Loc; + end Set_FieldX; + + function Get_Field1 is new Get_FieldX (1); + procedure Set_Field1 is new Set_FieldX (1); + + function Get_Field2 is new Get_FieldX (2); + procedure Set_Field2 is new Set_FieldX (2); + + function Get_Field3 is new Get_FieldX (3); + procedure Set_Field3 is new Set_FieldX (3); + + function Get_Field4 is new Get_FieldX (4); + procedure Set_Field4 is new Set_FieldX (4); + + function Get_Field5 is new Get_FieldX (5); + procedure Set_Field5 is new Set_FieldX (5); + + function Get_Field6 is new Get_FieldX (6); + procedure Set_Field6 is new Set_FieldX (6); + + -- Subprograms +end Vhdl.Elocations; |