From 0a088b311ed2fcebc542f8a2e42d09e2e3c9311c Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Tue, 4 Nov 2014 20:21:00 +0100 Subject: Create src/vhdl subdirectory. --- src/vhdl/nodes.adb | 467 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 467 insertions(+) create mode 100644 src/vhdl/nodes.adb (limited to 'src/vhdl/nodes.adb') diff --git a/src/vhdl/nodes.adb b/src/vhdl/nodes.adb new file mode 100644 index 0000000..2dc7736 --- /dev/null +++ b/src/vhdl/nodes.adb @@ -0,0 +1,467 @@ +-- Internal node type and operations. +-- 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 GNAT.Table; + +package body Nodes is + -- 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); + + -- Suppress discriminant checks on the table. Relatively safe, since + -- iirs do their own checks. + pragma Suppress (Discriminant_Check); + + package Nodet is new GNAT.Table + (Table_Component_Type => Node_Record, + Table_Index_Type => Node_Type, + Table_Low_Bound => 2, + Table_Initial => 1024, + Table_Increment => 100); + + function Get_Last_Node return Node_Type is + begin + return Nodet.Last; + end Get_Last_Node; + + Free_Chain : Node_Type := Null_Node; + + -- Just to have the default value. + pragma Warnings (Off); + Init_Short : Node_Record (Format_Short); + Init_Medium : Node_Record (Format_Medium); + Init_Fp : Node_Record (Format_Fp); + Init_Int : Node_Record (Format_Int); + pragma Warnings (On); + + function Create_Node (Format : Format_Type) return Node_Type + is + Res : Node_Type; + begin + if Format = Format_Medium then + -- 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_Medium; + Nodet.Table (Res + 1) := Init_Medium; + else + -- 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; + case Format is + when Format_Short => + Nodet.Table (Res) := Init_Short; + when Format_Medium => + raise Program_Error; + when Format_Fp => + Nodet.Table (Res) := Init_Fp; + when Format_Int => + Nodet.Table (Res) := Init_Int; + end case; + end if; + 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; + + 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 + | Format_Int + | Format_Fp => + 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 : Node_Type; Location: Location_Type) is + begin + Nodet.Table (N).Location := Location; + end Set_Location; + + function Get_Location (N: Node_Type) 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_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; + + function Get_State4 (N : Node_Type) return Bit2_Type is + begin + return Nodet.Table (N + 1).State2; + end Get_State4; + + procedure Set_State4 (N : Node_Type; V : Bit2_Type) is + begin + Nodet.Table (N + 1).State2 := V; + end Set_State4; + + + function Get_Odigit1 (N : Node_Type) return Bit3_Type is + begin + return Nodet.Table (N).Odigit1; + end Get_Odigit1; + + procedure Set_Odigit1 (N : Node_Type; V : Bit3_Type) is + begin + Nodet.Table (N).Odigit1 := V; + end Set_Odigit1; + + function Get_Odigit2 (N : Node_Type) return Bit3_Type is + begin + return Nodet.Table (N + 1).Odigit1; + end Get_Odigit2; + + procedure Set_Odigit2 (N : Node_Type; V : Bit3_Type) is + begin + Nodet.Table (N + 1).Odigit1 := V; + end Set_Odigit2; + + + function Get_Fp64 (N : Node_Type) return Iir_Fp64 is + begin + return Nodet.Table (N).Fp64; + end Get_Fp64; + + procedure Set_Fp64 (N : Node_Type; V : Iir_Fp64) is + begin + Nodet.Table (N).Fp64 := V; + end Set_Fp64; + + + function Get_Int64 (N : Node_Type) return Iir_Int64 is + begin + return Nodet.Table (N).Int64; + end Get_Int64; + + procedure Set_Int64 (N : Node_Type; V : Iir_Int64) is + begin + Nodet.Table (N).Int64 := V; + end Set_Int64; + + procedure Initialize is + begin + Nodet.Free; + Nodet.Init; + end Initialize; +end Nodes; -- cgit