Create src/vhdl subdirectory.

1 files changed, 229 insertions, 0 deletions

diff --git a/src/vhdl/iirs.adb.in b/src/vhdl/iirs.adb.in
new file mode 100644
index 0000000..04511bb
--- /dev/null
+++ b/src/vhdl/iirs.adb.in
@@ -0,0 +1,229 @@
+--  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 Ada.Text_IO;
+with Nodes; use Nodes;
+with Lists; use Lists;
+with Nodes_Meta; use Nodes_Meta;
+
+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 --
+   ---------------------------------------------------
+
+   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
+      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_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 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_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_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);
+
+   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 Iirs;