diff options
Diffstat (limited to 'iirs.adb.in')
| -rw-r--r-- | iirs.adb.in | 316 |
1 files changed, 316 insertions, 0 deletions
diff --git a/iirs.adb.in b/iirs.adb.in new file mode 100644 index 000000000..3af6920a4 --- /dev/null +++ b/iirs.adb.in @@ -0,0 +1,316 @@ +-- Tree node definitions. +-- 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 GCC; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with Ada.Unchecked_Deallocation; +with Ada.Unchecked_Conversion; +with Ada.Text_IO; +with Errorout; use Errorout; +with Nodes; use Nodes; +with Lists; use Lists; + +package body Iirs is + function Is_Null (Node : Iir) return Boolean is + begin + return Node = Null_Iir; + end Is_Null; + + function Is_Null_List (Node : Iir_List) return Boolean is + begin + return Node = Null_Iir_List; + end Is_Null_List; + + --------------------------------------------------- + -- General subprograms that operate on every iir -- + --------------------------------------------------- + + -- This is the procedure to call when an internal consistancy test has + -- failed. + -- The main idea is the consistancy test *MUST* have no side effect, + -- except calling this procedure. To speed up, this procedure could + -- be a no-op. + procedure Failed (Func: String := ""; Node : Iir := Null_Iir) + is + begin + if Func /= "" then + Error_Kind (Func, Node); + end if; + raise Internal_Error; + end Failed; + + function Get_Format (Kind : Iir_Kind) return Format_Type; + + -- Statistics. + procedure Disp_Stats + is + use Ada.Text_IO; + type Num_Array is array (Iir_Kind) of Natural; + Num : Num_Array := (others => 0); + type Format_Array is array (Format_Type) of Natural; + Formats : Format_Array := (others => 0); + Kind : Iir_Kind; + I : Iir; + Last_I : Iir; + Format : Format_Type; + begin + I := Error_Node + 1; + Last_I := Get_Last_Node; + while I < Last_I loop + Kind := Get_Kind (I); + Num (Kind) := Num (Kind) + 1; + Format := Get_Format (Kind); + Formats (Format) := Formats (Format) + 1; + case Format is + when Format_Medium => + I := I + 2; + when Format_Short + | Format_Fp + | Format_Int => + I := I + 1; + end case; + end loop; + + Put_Line ("Stats per iir_kind:"); + for J in Iir_Kind loop + if Num (J) /= 0 then + Put_Line (' ' & Iir_Kind'Image (J) & ':' + & Natural'Image (Num (J))); + end if; + end loop; + Put_Line ("Stats per formats:"); + for J in Format_Type loop + Put_Line (' ' & Format_Type'Image (J) & ':' + & Natural'Image (Formats (J))); + end loop; + end Disp_Stats; + + function Iir_Predefined_Shortcut_P (Func : Iir_Predefined_Functions) + return Boolean is + begin + case Func is + when Iir_Predefined_Bit_And + | Iir_Predefined_Bit_Or + | Iir_Predefined_Bit_Nand + | Iir_Predefined_Bit_Nor + | Iir_Predefined_Boolean_And + | Iir_Predefined_Boolean_Or + | Iir_Predefined_Boolean_Nand + | Iir_Predefined_Boolean_Nor => + return True; + when others => + return False; + end case; + end Iir_Predefined_Shortcut_P; + + function Create_Proxy (Proxy: Iir) return Iir_Proxy is + Res : Iir_Proxy; + begin + Res := Create_Iir (Iir_Kind_Proxy); + Set_Proxy (Res, Proxy); + return Res; + end Create_Proxy; + + -- + + function Create_Iir_Error return Iir + is + Res : Iir; + begin + Res := Create_Node (Format_Short); + Set_Nkind (Res, Iir_Kind'Pos (Iir_Kind_Error)); + Set_Base_Type (Res, Res); + return Res; + end Create_Iir_Error; + + procedure Location_Copy (Target: Iir; Src: Iir) is + begin + Set_Location (Target, Get_Location (Src)); + end Location_Copy; + + -- Get kind + function Get_Kind (An_Iir: Iir) return Iir_Kind + is + -- Speed up: avoid to check that nkind is in the bounds of Iir_Kind. + pragma Suppress (Range_Check); + begin + return Iir_Kind'Val (Get_Nkind (An_Iir)); + end Get_Kind; + +-- function Clone_Iir (Src : Iir; New_Kind : Iir_Kind) return Iir +-- is +-- Res : Iir; +-- begin +-- Res := new Iir_Node (New_Kind); +-- Res.Flag1 := Src.Flag1; +-- Res.Flag2 := Src.Flag2; +-- Res.Flag3 := Src.Flag3; +-- Res.Flag4 := Src.Flag4; +-- Res.Flag5 := Src.Flag5; +-- Res.Flag6 := Src.Flag6; +-- Res.Flag7 := Src.Flag7; +-- Res.Flag8 := Src.Flag8; +-- Res.State1 := Src.State1; +-- Res.State2 := Src.State2; +-- Res.State3 := Src.State3; +-- Res.Staticness1 := Src.Staticness1; +-- Res.Staticness2 := Src.Staticness2; +-- Res.Odigit1 := Src.Odigit1; +-- Res.Odigit2 := Src.Odigit2; +-- Res.Location := Src.Location; +-- Res.Back_End_Info := Src.Back_End_Info; +-- Res.Identifier := Src.Identifier; +-- Res.Field1 := Src.Field1; +-- Res.Field2 := Src.Field2; +-- Res.Field3 := Src.Field3; +-- Res.Field4 := Src.Field4; +-- Res.Field5 := Src.Field5; +-- Res.Nbr2 := Src.Nbr2; +-- Res.Nbr3 := Src.Nbr3; + +-- Src.Identifier := Null_Identifier; +-- Src.Field1 := null; +-- Src.Field2 := null; +-- Src.Field3 := null; +-- Src.Field4 := null; +-- Src.Field5 := null; +-- return Res; +-- end Clone_Iir; + + + ----------------- + -- design file -- + ----------------- + + -- Iir_Design_File + +-- type Int_Access_Type is new Integer; +-- for Int_Access_Type'Size use System.Word_Size; --Iir_Identifier_Acc'Size; + + -- Safe conversions. +-- function Iir_To_Int_Access_Type is +-- new Ada.Unchecked_Conversion (Source => Iir, +-- Target => Int_Access_Type); +-- function Int_Access_Type_To_Iir is +-- new Ada.Unchecked_Conversion (Source => Int_Access_Type, +-- Target => Iir); + +-- function To_Iir (V : Integer) return Iir is +-- begin +-- return Int_Access_Type_To_Iir (Int_Access_Type (V)); +-- end To_Iir; + +-- function To_Integer (N : Iir) return Integer is +-- begin +-- return Integer (Iir_To_Int_Access_Type (N)); +-- end To_Integer; + + procedure Set_Pos_Line_Off (Design_Unit: Iir_Design_Unit; + Pos : Source_Ptr; Line, Off: Natural) is + begin + Set_Field1 (Design_Unit, Node_Type (Pos)); + Set_Field11 (Design_Unit, Node_Type (Off)); + Set_Field12 (Design_Unit, Node_Type (Line)); + end Set_Pos_Line_Off; + + procedure Get_Pos_Line_Off (Design_Unit: Iir_Design_Unit; + Pos : out Source_Ptr; Line, Off: out Natural) is + begin + Pos := Source_Ptr (Get_Field1 (Design_Unit)); + Off := Natural (Get_Field11 (Design_Unit)); + Line := Natural (Get_Field12 (Design_Unit)); + end Get_Pos_Line_Off; + + ----------- + -- Lists -- + ----------- + -- Layout of lists: + -- A list is stored into an IIR. + -- There are two bounds for a list: + -- the current number of elements + -- the maximum number of elements. + -- Using a maximum number of element bound (which can be increased) avoid + -- to reallocating memory at each insertion. + + function Time_Stamp_Id_To_Iir is new Ada.Unchecked_Conversion + (Source => Time_Stamp_Id, Target => Iir); + + function Iir_To_Time_Stamp_Id is new Ada.Unchecked_Conversion + (Source => Iir, Target => Time_Stamp_Id); + + function Iir_To_Iir_List is new Ada.Unchecked_Conversion + (Source => Iir, Target => Iir_List); + function Iir_List_To_Iir is new Ada.Unchecked_Conversion + (Source => Iir_List, Target => Iir); + + function Iir_To_Token_Type (N : Iir) return Token_Type is + begin + return Token_Type'Val (N); + end Iir_To_Token_Type; + + function Token_Type_To_Iir (T : Token_Type) return Iir is + begin + return Token_Type'Pos (T); + end Token_Type_To_Iir; + + function Iir_To_Iir_Index32 (N : Iir) return Iir_Index32 is + begin + return Iir_Index32 (N); + end Iir_To_Iir_Index32; + + function Iir_Index32_To_Iir (V : Iir_Index32) return Iir is + begin + return Iir_Index32'Pos (V); + end Iir_Index32_To_Iir; + + function Iir_To_Name_Id (N : Iir) return Name_Id is + begin + return Iir'Pos (N); + end Iir_To_Name_Id; + pragma Inline (Iir_To_Name_Id); + + function Name_Id_To_Iir (V : Name_Id) return Iir is + begin + return Name_Id'Pos (V); + end Name_Id_To_Iir; + + function Iir_To_Iir_Int32 is new Ada.Unchecked_Conversion + (Source => Iir, Target => Iir_Int32); + + function Iir_Int32_To_Iir is new Ada.Unchecked_Conversion + (Source => Iir_Int32, Target => Iir); + + function Iir_To_Location_Type (N : Iir) return Location_Type is + begin + return Location_Type (N); + end Iir_To_Location_Type; + + function Location_Type_To_Iir (L : Location_Type) return Iir is + begin + return Iir (L); + end Location_Type_To_Iir; + + function Iir_To_String_Id is new Ada.Unchecked_Conversion + (Source => Iir, Target => String_Id); + function String_Id_To_Iir is new Ada.Unchecked_Conversion + (Source => String_Id, Target => Iir); + + function Iir_To_Int32 is new Ada.Unchecked_Conversion + (Source => Iir, Target => Int32); + function Int32_To_Iir is new Ada.Unchecked_Conversion + (Source => Int32, Target => Iir); + + -- Subprograms +end Iirs; |