diff options
Diffstat (limited to 'src/vhdl/vhdl-nodes.adb.in')
| -rw-r--r-- | src/vhdl/vhdl-nodes.adb.in | 948 |
1 files changed, 948 insertions, 0 deletions
diff --git a/src/vhdl/vhdl-nodes.adb.in b/src/vhdl/vhdl-nodes.adb.in new file mode 100644 index 000000000..0dee1df81 --- /dev/null +++ b/src/vhdl/vhdl-nodes.adb.in @@ -0,0 +1,948 @@ +-- 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 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.Unchecked_Conversion; +with Tables; +with Logging; use Logging; +with Lists; use Lists; +with Nodes_Meta; use Nodes_Meta; +with Vhdl.Nodes_Priv; use Vhdl.Nodes_Priv; + +package body Vhdl.Nodes is + -- A simple type that needs only 2 bits. + type Bit2_Type is range 0 .. 2 ** 2 - 1; + + type Kind_Type is range 0 .. 2 ** 9 - 1; + + -- Format of a node. + type Format_Type is + ( + Format_Short, + Format_Medium + ); + + -- Common fields are: + -- Flag1 : Boolean + -- Flag2 : Boolean + -- Flag3 : Boolean + -- Flag4 : Boolean + -- Flag5 : Boolean + -- Flag6 : Boolean + -- Flag7 : Boolean + -- Flag8 : Boolean + -- Flag9 : Boolean + -- Flag10 : Boolean + -- Flag11 : Boolean + -- Flag12 : Boolean + -- Flag13 : Boolean + -- Flag14 : Boolean + -- Flag15 : Boolean + -- Nkind : Kind_Type + -- State1 : Bit2_Type + -- State2 : Bit2_Type + -- Location : Location_Type + -- Field0 : Iir + -- Field1 : Iir + -- Field2 : Iir + -- Field3 : Iir + -- Field4 : Iir + -- Field5 : Iir + + -- Fields of Format_Short: + + -- Fields of Format_Medium: + -- State3 : Bit2_Type + -- State4 : Bit2_Type + -- Field6 : Iir (location) + -- Field7 : Iir (field0) + -- Field8 : Iir (field1) + -- Field9 : Iir (field2) + -- Field10 : Iir (field3) + -- Field11 : Iir (field4) + -- Field12 : Iir (field5) + + function Create_Node (Format : Format_Type) return Node_Type; + procedure Free_Node (N : Node_Type); + + function Get_Nkind (N : Node_Type) return Kind_Type; + pragma Inline (Get_Nkind); + procedure Set_Nkind (N : Node_Type; Kind : Kind_Type); + pragma Inline (Set_Nkind); + + function Get_Field0 (N : Node_Type) return Node_Type; + pragma Inline (Get_Field0); + procedure Set_Field0 (N : Node_Type; V : Node_Type); + pragma Inline (Set_Field0); + + function Get_Field1 (N : Node_Type) return Node_Type; + pragma Inline (Get_Field1); + procedure Set_Field1 (N : Node_Type; V : Node_Type); + pragma Inline (Set_Field1); + + function Get_Field2 (N : Node_Type) return Node_Type; + pragma Inline (Get_Field2); + procedure Set_Field2 (N : Node_Type; V : Node_Type); + pragma Inline (Set_Field2); + + function Get_Field3 (N : Node_Type) return Node_Type; + pragma Inline (Get_Field3); + procedure Set_Field3 (N : Node_Type; V : Node_Type); + pragma Inline (Set_Field3); + + function Get_Field4 (N : Node_Type) return Node_Type; + pragma Inline (Get_Field4); + procedure Set_Field4 (N : Node_Type; V : Node_Type); + pragma Inline (Set_Field4); + + + function Get_Field5 (N : Node_Type) return Node_Type; + pragma Inline (Get_Field5); + procedure Set_Field5 (N : Node_Type; V : Node_Type); + pragma Inline (Set_Field5); + + function Get_Field6 (N: Node_Type) return Node_Type; + pragma Inline (Get_Field6); + procedure Set_Field6 (N: Node_Type; Val: Node_Type); + pragma Inline (Set_Field6); + + function Get_Field7 (N: Node_Type) return Node_Type; + pragma Inline (Get_Field7); + procedure Set_Field7 (N: Node_Type; Val: Node_Type); + pragma Inline (Set_Field7); + + function Get_Field8 (N: Node_Type) return Node_Type; + pragma Inline (Get_Field8); + procedure Set_Field8 (N: Node_Type; Val: Node_Type); + pragma Inline (Set_Field8); + + function Get_Field9 (N: Node_Type) return Node_Type; + pragma Inline (Get_Field9); + procedure Set_Field9 (N: Node_Type; Val: Node_Type); + pragma Inline (Set_Field9); + + function Get_Field10 (N: Node_Type) return Node_Type; + pragma Inline (Get_Field10); + procedure Set_Field10 (N: Node_Type; Val: Node_Type); + pragma Inline (Set_Field10); + + function Get_Field11 (N: Node_Type) return Node_Type; + pragma Inline (Get_Field11); + procedure Set_Field11 (N: Node_Type; Val: Node_Type); + pragma Inline (Set_Field11); + + function Get_Field12 (N: Node_Type) return Node_Type; + pragma Inline (Get_Field12); + procedure Set_Field12 (N: Node_Type; Val: Node_Type); + pragma Inline (Set_Field12); + + + function Get_Flag1 (N : Node_Type) return Boolean; + pragma Inline (Get_Flag1); + procedure Set_Flag1 (N : Node_Type; V : Boolean); + pragma Inline (Set_Flag1); + + function Get_Flag2 (N : Node_Type) return Boolean; + pragma Inline (Get_Flag2); + procedure Set_Flag2 (N : Node_Type; V : Boolean); + pragma Inline (Set_Flag2); + + function Get_Flag3 (N : Node_Type) return Boolean; + pragma Inline (Get_Flag3); + procedure Set_Flag3 (N : Node_Type; V : Boolean); + pragma Inline (Set_Flag3); + + function Get_Flag4 (N : Node_Type) return Boolean; + pragma Inline (Get_Flag4); + procedure Set_Flag4 (N : Node_Type; V : Boolean); + pragma Inline (Set_Flag4); + + function Get_Flag5 (N : Node_Type) return Boolean; + pragma Inline (Get_Flag5); + procedure Set_Flag5 (N : Node_Type; V : Boolean); + pragma Inline (Set_Flag5); + + function Get_Flag6 (N : Node_Type) return Boolean; + pragma Inline (Get_Flag6); + procedure Set_Flag6 (N : Node_Type; V : Boolean); + pragma Inline (Set_Flag6); + + function Get_Flag7 (N : Node_Type) return Boolean; + pragma Inline (Get_Flag7); + procedure Set_Flag7 (N : Node_Type; V : Boolean); + pragma Inline (Set_Flag7); + + function Get_Flag8 (N : Node_Type) return Boolean; + pragma Inline (Get_Flag8); + procedure Set_Flag8 (N : Node_Type; V : Boolean); + pragma Inline (Set_Flag8); + + function Get_Flag9 (N : Node_Type) return Boolean; + pragma Inline (Get_Flag9); + procedure Set_Flag9 (N : Node_Type; V : Boolean); + pragma Inline (Set_Flag9); + + function Get_Flag10 (N : Node_Type) return Boolean; + pragma Inline (Get_Flag10); + procedure Set_Flag10 (N : Node_Type; V : Boolean); + pragma Inline (Set_Flag10); + + function Get_Flag11 (N : Node_Type) return Boolean; + pragma Inline (Get_Flag11); + procedure Set_Flag11 (N : Node_Type; V : Boolean); + pragma Inline (Set_Flag11); + + function Get_Flag12 (N : Node_Type) return Boolean; + pragma Inline (Get_Flag12); + procedure Set_Flag12 (N : Node_Type; V : Boolean); + pragma Inline (Set_Flag12); + + function Get_Flag13 (N : Node_Type) return Boolean; + pragma Inline (Get_Flag13); + procedure Set_Flag13 (N : Node_Type; V : Boolean); + pragma Inline (Set_Flag13); + + function Get_Flag14 (N : Node_Type) return Boolean; + pragma Inline (Get_Flag14); + procedure Set_Flag14 (N : Node_Type; V : Boolean); + pragma Inline (Set_Flag14); + + function Get_Flag15 (N : Node_Type) return Boolean; + pragma Inline (Get_Flag15); + procedure Set_Flag15 (N : Node_Type; V : Boolean); + pragma Inline (Set_Flag15); + + + function Get_State1 (N : Node_Type) return Bit2_Type; + pragma Inline (Get_State1); + procedure Set_State1 (N : Node_Type; V : Bit2_Type); + pragma Inline (Set_State1); + + function Get_State2 (N : Node_Type) return Bit2_Type; + pragma Inline (Get_State2); + procedure Set_State2 (N : Node_Type; V : Bit2_Type); + pragma Inline (Set_State2); + + function Get_State3 (N : Node_Type) return Bit2_Type; + pragma Inline (Get_State3); + procedure Set_State3 (N : Node_Type; V : Bit2_Type); + pragma Inline (Set_State3); + + type Node_Record is record + -- First byte: + Format : Format_Type; + Flag1 : Boolean; + Flag2 : Boolean; + Flag3 : Boolean; + Flag4 : Boolean; + Flag5 : Boolean; + Flag6 : Boolean; + Flag7 : Boolean; + + -- Second byte: + Flag8 : Boolean; + Flag9 : Boolean; + Flag10 : Boolean; + Flag11 : Boolean; + Flag12 : Boolean; + Flag13 : Boolean; + Flag14 : Boolean; + Flag15 : Boolean; + + -- Third byte: + Flag16 : Boolean; + Flag17 : Boolean; + Flag18 : Boolean; + + -- 2*2 = 4 bits + State1 : Bit2_Type; + State2 : Bit2_Type; + + -- 9 bits + Kind : Kind_Type; + + -- Location. + Location: Location_Type; + + Field0 : Node_Type; + Field1 : Node_Type; + Field2 : Node_Type; + Field3 : Node_Type; + Field4 : Node_Type; + Field5 : Node_Type; + end record; + pragma Pack (Node_Record); + for Node_Record'Size use 8*32; + for Node_Record'Alignment use 4; + pragma Suppress_Initialization (Node_Record); + + Init_Node : constant Node_Record := Node_Record' + (Format => Format_Short, + Kind => 0, + State1 | State2 => 0, + Location => Location_Nil, + Field0 | Field1 | Field2 | Field3 | Field4 | Field5 => Null_Node, + others => False); + + -- Suppress the access check of the table base. This is really safe to + -- suppress this check because the table base cannot be null. + pragma Suppress (Access_Check); + + -- Suppress the index check on the table. + -- Could be done during non-debug, since this may catch errors (reading + -- Null_Node or Error_Node). + --pragma Suppress (Index_Check); + + package Nodet is new Tables + (Table_Component_Type => Node_Record, + Table_Index_Type => Node_Type, + Table_Low_Bound => 2, + Table_Initial => 1024); + + function Get_Last_Node return Iir is + begin + return Nodet.Last; + end Get_Last_Node; + + Free_Chain : Node_Type := Null_Node; + + function Create_Node (Format : Format_Type) return Node_Type + is + Res : Node_Type; + begin + case Format is + when Format_Medium => + -- Allocate a first node. + Nodet.Increment_Last; + Res := Nodet.Last; + -- Check alignment. + if Res mod 2 = 1 then + Set_Field1 (Res, Free_Chain); + Free_Chain := Res; + Nodet.Increment_Last; + Res := Nodet.Last; + end if; + -- Allocate the second node. + Nodet.Increment_Last; + Nodet.Table (Res) := Init_Node; + Nodet.Table (Res).Format := Format_Medium; + Nodet.Table (Res + 1) := Init_Node; + when Format_Short => + -- Check from free pool + if Free_Chain = Null_Node then + Nodet.Increment_Last; + Res := Nodet.Last; + else + Res := Free_Chain; + Free_Chain := Get_Field1 (Res); + end if; + Nodet.Table (Res) := Init_Node; + end case; + return Res; + end Create_Node; + + procedure Free_Node (N : Node_Type) + is + begin + if N /= Null_Node then + Set_Nkind (N, 0); + Set_Field1 (N, Free_Chain); + Free_Chain := N; + if Nodet.Table (N).Format = Format_Medium then + Set_Field1 (N + 1, Free_Chain); + Free_Chain := N + 1; + end if; + end if; + end Free_Node; + + procedure Free_Iir (Target : Iir) renames Free_Node; + + function Next_Node (N : Node_Type) return Node_Type is + begin + case Nodet.Table (N).Format is + when Format_Medium => + return N + 2; + when Format_Short => + return N + 1; + end case; + end Next_Node; + + function Get_Nkind (N : Node_Type) return Kind_Type is + begin + return Nodet.Table (N).Kind; + end Get_Nkind; + + procedure Set_Nkind (N : Node_Type; Kind : Kind_Type) is + begin + Nodet.Table (N).Kind := Kind; + end Set_Nkind; + + + procedure Set_Location (N : Iir; Location: Location_Type) is + begin + Nodet.Table (N).Location := Location; + end Set_Location; + + function Get_Location (N: Iir) return Location_Type is + begin + return Nodet.Table (N).Location; + end Get_Location; + + + procedure Set_Field0 (N : Node_Type; V : Node_Type) is + begin + Nodet.Table (N).Field0 := V; + end Set_Field0; + + function Get_Field0 (N : Node_Type) return Node_Type is + begin + return Nodet.Table (N).Field0; + end Get_Field0; + + + function Get_Field1 (N : Node_Type) return Node_Type is + begin + return Nodet.Table (N).Field1; + end Get_Field1; + + procedure Set_Field1 (N : Node_Type; V : Node_Type) is + begin + Nodet.Table (N).Field1 := V; + end Set_Field1; + + function Get_Field2 (N : Node_Type) return Node_Type is + begin + return Nodet.Table (N).Field2; + end Get_Field2; + + procedure Set_Field2 (N : Node_Type; V : Node_Type) is + begin + Nodet.Table (N).Field2 := V; + end Set_Field2; + + function Get_Field3 (N : Node_Type) return Node_Type is + begin + return Nodet.Table (N).Field3; + end Get_Field3; + + procedure Set_Field3 (N : Node_Type; V : Node_Type) is + begin + Nodet.Table (N).Field3 := V; + end Set_Field3; + + function Get_Field4 (N : Node_Type) return Node_Type is + begin + return Nodet.Table (N).Field4; + end Get_Field4; + + procedure Set_Field4 (N : Node_Type; V : Node_Type) is + begin + Nodet.Table (N).Field4 := V; + end Set_Field4; + + function Get_Field5 (N : Node_Type) return Node_Type is + begin + return Nodet.Table (N).Field5; + end Get_Field5; + + procedure Set_Field5 (N : Node_Type; V : Node_Type) is + begin + Nodet.Table (N).Field5 := V; + end Set_Field5; + + function Get_Field6 (N: Node_Type) return Node_Type is + begin + return Node_Type (Nodet.Table (N + 1).Location); + end Get_Field6; + + procedure Set_Field6 (N: Node_Type; Val: Node_Type) is + begin + Nodet.Table (N + 1).Location := Location_Type (Val); + end Set_Field6; + + function Get_Field7 (N: Node_Type) return Node_Type is + begin + return Nodet.Table (N + 1).Field0; + end Get_Field7; + + procedure Set_Field7 (N: Node_Type; Val: Node_Type) is + begin + Nodet.Table (N + 1).Field0 := Val; + end Set_Field7; + + function Get_Field8 (N: Node_Type) return Node_Type is + begin + return Nodet.Table (N + 1).Field1; + end Get_Field8; + + procedure Set_Field8 (N: Node_Type; Val: Node_Type) is + begin + Nodet.Table (N + 1).Field1 := Val; + end Set_Field8; + + function Get_Field9 (N: Node_Type) return Node_Type is + begin + return Nodet.Table (N + 1).Field2; + end Get_Field9; + + procedure Set_Field9 (N: Node_Type; Val: Node_Type) is + begin + Nodet.Table (N + 1).Field2 := Val; + end Set_Field9; + + function Get_Field10 (N: Node_Type) return Node_Type is + begin + return Nodet.Table (N + 1).Field3; + end Get_Field10; + + procedure Set_Field10 (N: Node_Type; Val: Node_Type) is + begin + Nodet.Table (N + 1).Field3 := Val; + end Set_Field10; + + function Get_Field11 (N: Node_Type) return Node_Type is + begin + return Nodet.Table (N + 1).Field4; + end Get_Field11; + + procedure Set_Field11 (N: Node_Type; Val: Node_Type) is + begin + Nodet.Table (N + 1).Field4 := Val; + end Set_Field11; + + function Get_Field12 (N: Node_Type) return Node_Type is + begin + return Nodet.Table (N + 1).Field5; + end Get_Field12; + + procedure Set_Field12 (N: Node_Type; Val: Node_Type) is + begin + Nodet.Table (N + 1).Field5 := Val; + end Set_Field12; + + + function Get_Flag1 (N : Node_Type) return Boolean is + begin + return Nodet.Table (N).Flag1; + end Get_Flag1; + + procedure Set_Flag1 (N : Node_Type; V : Boolean) is + begin + Nodet.Table (N).Flag1 := V; + end Set_Flag1; + + function Get_Flag2 (N : Node_Type) return Boolean is + begin + return Nodet.Table (N).Flag2; + end Get_Flag2; + + procedure Set_Flag2 (N : Node_Type; V : Boolean) is + begin + Nodet.Table (N).Flag2 := V; + end Set_Flag2; + + function Get_Flag3 (N : Node_Type) return Boolean is + begin + return Nodet.Table (N).Flag3; + end Get_Flag3; + + procedure Set_Flag3 (N : Node_Type; V : Boolean) is + begin + Nodet.Table (N).Flag3 := V; + end Set_Flag3; + + function Get_Flag4 (N : Node_Type) return Boolean is + begin + return Nodet.Table (N).Flag4; + end Get_Flag4; + + procedure Set_Flag4 (N : Node_Type; V : Boolean) is + begin + Nodet.Table (N).Flag4 := V; + end Set_Flag4; + + function Get_Flag5 (N : Node_Type) return Boolean is + begin + return Nodet.Table (N).Flag5; + end Get_Flag5; + + procedure Set_Flag5 (N : Node_Type; V : Boolean) is + begin + Nodet.Table (N).Flag5 := V; + end Set_Flag5; + + function Get_Flag6 (N : Node_Type) return Boolean is + begin + return Nodet.Table (N).Flag6; + end Get_Flag6; + + procedure Set_Flag6 (N : Node_Type; V : Boolean) is + begin + Nodet.Table (N).Flag6 := V; + end Set_Flag6; + + function Get_Flag7 (N : Node_Type) return Boolean is + begin + return Nodet.Table (N).Flag7; + end Get_Flag7; + + procedure Set_Flag7 (N : Node_Type; V : Boolean) is + begin + Nodet.Table (N).Flag7 := V; + end Set_Flag7; + + function Get_Flag8 (N : Node_Type) return Boolean is + begin + return Nodet.Table (N).Flag8; + end Get_Flag8; + + procedure Set_Flag8 (N : Node_Type; V : Boolean) is + begin + Nodet.Table (N).Flag8 := V; + end Set_Flag8; + + function Get_Flag9 (N : Node_Type) return Boolean is + begin + return Nodet.Table (N).Flag9; + end Get_Flag9; + + procedure Set_Flag9 (N : Node_Type; V : Boolean) is + begin + Nodet.Table (N).Flag9 := V; + end Set_Flag9; + + function Get_Flag10 (N : Node_Type) return Boolean is + begin + return Nodet.Table (N).Flag10; + end Get_Flag10; + + procedure Set_Flag10 (N : Node_Type; V : Boolean) is + begin + Nodet.Table (N).Flag10 := V; + end Set_Flag10; + + function Get_Flag11 (N : Node_Type) return Boolean is + begin + return Nodet.Table (N).Flag11; + end Get_Flag11; + + procedure Set_Flag11 (N : Node_Type; V : Boolean) is + begin + Nodet.Table (N).Flag11 := V; + end Set_Flag11; + + function Get_Flag12 (N : Node_Type) return Boolean is + begin + return Nodet.Table (N).Flag12; + end Get_Flag12; + + procedure Set_Flag12 (N : Node_Type; V : Boolean) is + begin + Nodet.Table (N).Flag12 := V; + end Set_Flag12; + + function Get_Flag13 (N : Node_Type) return Boolean is + begin + return Nodet.Table (N).Flag13; + end Get_Flag13; + + procedure Set_Flag13 (N : Node_Type; V : Boolean) is + begin + Nodet.Table (N).Flag13 := V; + end Set_Flag13; + + function Get_Flag14 (N : Node_Type) return Boolean is + begin + return Nodet.Table (N).Flag14; + end Get_Flag14; + + procedure Set_Flag14 (N : Node_Type; V : Boolean) is + begin + Nodet.Table (N).Flag14 := V; + end Set_Flag14; + + function Get_Flag15 (N : Node_Type) return Boolean is + begin + return Nodet.Table (N).Flag15; + end Get_Flag15; + + procedure Set_Flag15 (N : Node_Type; V : Boolean) is + begin + Nodet.Table (N).Flag15 := V; + end Set_Flag15; + + + function Get_State1 (N : Node_Type) return Bit2_Type is + begin + return Nodet.Table (N).State1; + end Get_State1; + + procedure Set_State1 (N : Node_Type; V : Bit2_Type) is + begin + Nodet.Table (N).State1 := V; + end Set_State1; + + function Get_State2 (N : Node_Type) return Bit2_Type is + begin + return Nodet.Table (N).State2; + end Get_State2; + + procedure Set_State2 (N : Node_Type; V : Bit2_Type) is + begin + Nodet.Table (N).State2 := V; + end Set_State2; + + function Get_State3 (N : Node_Type) return Bit2_Type is + begin + return Nodet.Table (N + 1).State1; + end Get_State3; + + procedure Set_State3 (N : Node_Type; V : Bit2_Type) is + begin + Nodet.Table (N + 1).State1 := V; + end Set_State3; + + procedure Initialize is + begin + Nodet.Free; + Nodet.Init; + end Initialize; + + 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; + + function Is_Valid (Node : Iir) return Boolean is + begin + return Node /= Null_Iir; + end Is_Valid; + + --------------------------------------------------- + -- General subprograms that operate on every iir -- + --------------------------------------------------- + + function Get_Format (Kind : Iir_Kind) return Format_Type; + + function Create_Iir (Kind : Iir_Kind) return Iir + is + Res : Iir; + Format : Format_Type; + begin + Format := Get_Format (Kind); + Res := Create_Node (Format); + Set_Nkind (Res, Iir_Kind'Pos (Kind)); + return Res; + end Create_Iir; + + -- Statistics. + procedure Disp_Stats + is + 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; + I := Next_Node (I); + end loop; + + Log_Line ("Stats per iir_kind:"); + for J in Iir_Kind loop + if Num (J) /= 0 then + Log_Line (' ' & Iir_Kind'Image (J) & ':' + & Natural'Image (Num (J))); + end if; + end loop; + Log_Line ("Stats per formats:"); + for J in Format_Type loop + Log_Line (' ' & Format_Type'Image (J) & ':' + & Natural'Image (Formats (J))); + end loop; + end Disp_Stats; + + function Kind_In (K : Iir_Kind; K1, K2 : Iir_Kind) return Boolean is + begin + return K = K1 or K = K2; + end Kind_In; + + 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_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 (N : Iir) return Iir_Kind + is + -- Speed up: avoid to check that nkind is in the bounds of Iir_Kind. + pragma Suppress (Range_Check); + begin + pragma Assert (N /= Null_Iir); + return Iir_Kind'Val (Get_Nkind (N)); + end Get_Kind; + + 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 File_Checksum_Id_To_Iir is new Ada.Unchecked_Conversion + (Source => File_Checksum_Id, Target => Iir); + + function Iir_To_File_Checksum_Id is new Ada.Unchecked_Conversion + (Source => Iir, Target => File_Checksum_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_Iir_Flist is new Ada.Unchecked_Conversion + (Source => Iir, Target => Iir_Flist); + function Iir_Flist_To_Iir is new Ada.Unchecked_Conversion + (Source => Iir_Flist, 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_Source_Ptr (N : Iir) return Source_Ptr is + begin + return Source_Ptr (N); + end Iir_To_Source_Ptr; + + function Source_Ptr_To_Iir (P : Source_Ptr) return Iir is + begin + return Iir (P); + end Source_Ptr_To_Iir; + + function Iir_To_Source_File_Entry is new Ada.Unchecked_Conversion + (Source => Iir, Target => Source_File_Entry); + function Source_File_Entry_To_Iir is new Ada.Unchecked_Conversion + (Source => Source_File_Entry, Target => Iir); + + function Boolean_To_Iir_Delay_Mechanism is new Ada.Unchecked_Conversion + (Source => Boolean, Target => Iir_Delay_Mechanism); + function Iir_Delay_Mechanism_To_Boolean is new Ada.Unchecked_Conversion + (Source => Iir_Delay_Mechanism, Target => Boolean); + + function Boolean_To_Iir_Signal_Kind is new Ada.Unchecked_Conversion + (Source => Boolean, Target => Iir_Signal_Kind); + function Iir_Signal_Kind_To_Boolean is new Ada.Unchecked_Conversion + (Source => Iir_Signal_Kind, Target => Boolean); + + function Iir_To_String8_Id is new Ada.Unchecked_Conversion + (Source => Iir, Target => String8_Id); + function String8_Id_To_Iir is new Ada.Unchecked_Conversion + (Source => String8_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); + + function Iir_To_PSL_Node is new Ada.Unchecked_Conversion + (Source => Iir, Target => PSL_Node); + + function PSL_Node_To_Iir is new Ada.Unchecked_Conversion + (Source => PSL_Node, Target => Iir); + + function Iir_To_PSL_NFA is new Ada.Unchecked_Conversion + (Source => Iir, Target => PSL_NFA); + + function PSL_NFA_To_Iir is new Ada.Unchecked_Conversion + (Source => PSL_NFA, Target => Iir); + + -- Subprograms +end Vhdl.Nodes; |