aboutsummaryrefslogtreecommitdiffstats
path: root/src/vhdl
diff options
context:
space:
mode:
authorTristan Gingold <tgingold@free.fr>2019-05-05 13:54:39 +0200
committerTristan Gingold <tgingold@free.fr>2019-05-05 16:03:03 +0200
commit7892c6e7945d5e4b46ddde4f18debe1c06bd3e12 (patch)
tree60b168224aaccf8421858bab2d600c1e4b0592ef /src/vhdl
parente4960acab358ebdd76d796554f962e755ec8954c (diff)
downloadghdl-7892c6e7945d5e4b46ddde4f18debe1c06bd3e12.tar.gz
ghdl-7892c6e7945d5e4b46ddde4f18debe1c06bd3e12.tar.bz2
ghdl-7892c6e7945d5e4b46ddde4f18debe1c06bd3e12.zip
vhdl: move nodes to vhdl.nodes_priv.
Diffstat (limited to 'src/vhdl')
-rw-r--r--src/vhdl/Makefile18
-rw-r--r--src/vhdl/flists.ads2
-rw-r--r--src/vhdl/iirs.adb702
-rw-r--r--src/vhdl/iirs.adb.in702
-rw-r--r--src/vhdl/iirs.ads29
-rw-r--r--src/vhdl/nodes.adb452
-rw-r--r--src/vhdl/nodes.ads320
-rw-r--r--src/vhdl/translate/trans.adb6
-rw-r--r--src/vhdl/vhdl-elocations.adb8
-rw-r--r--src/vhdl/vhdl-elocations.adb.in8
-rw-r--r--src/vhdl/vhdl-nodes_gc.adb3
-rw-r--r--src/vhdl/vhdl-nodes_priv.ads28
-rw-r--r--src/vhdl/vhdl-sem_inst.adb10
-rw-r--r--src/vhdl/vhdl-types.ads24
-rw-r--r--src/vhdl/xrefs.adb4
15 files changed, 1501 insertions, 815 deletions
diff --git a/src/vhdl/Makefile b/src/vhdl/Makefile
index a18d334c6..dc13ff90f 100644
--- a/src/vhdl/Makefile
+++ b/src/vhdl/Makefile
@@ -23,7 +23,7 @@
PNODES=../xtools/pnodes.py
PNODESPY=python/pnodespy.py
-DEPS=iirs.ads nodes.ads $(PNODES)
+DEPS=iirs.ads iirs.adb.in $(PNODES)
GEN_FILES=iirs.adb nodes_meta.ads nodes_meta.adb \
vhdl-elocations.adb vhdl-elocations_meta.ads vhdl-elocations_meta.adb \
@@ -31,6 +31,8 @@ GEN_FILES=iirs.adb nodes_meta.ads nodes_meta.adb \
python/libghdl/std_names.py python/libghdl/tokens.py \
python/libghdl/elocations.py python/libghdl/errorout.py
+NODES_FLAGS=--field-file=iirs.adb.in
+
ELOCATIONS_FLAGS=--node-file=vhdl-elocations.ads \
--field-file=vhdl-elocations.adb.in \
--template-file=vhdl-elocations.adb.in --meta-basename=vhdl-elocations_meta
@@ -39,17 +41,17 @@ all: $(GEN_FILES)
iirs.adb: iirs.adb.in $(DEPS)
$(RM) $@
- $(PNODES) body > $@
+ $(PNODES) $(NODES_FLAGS) body > $@
chmod -w $@
nodes_meta.ads: nodes_meta.ads.in $(DEPS)
$(RM) $@
- $(PNODES) meta_specs > $@
+ $(PNODES) $(NODES_FLAGS) meta_specs > $@
chmod -w $@
nodes_meta.adb: nodes_meta.adb.in $(DEPS)
$(RM) $@
- $(PNODES) meta_body > $@
+ $(PNODES) $(NODES_FLAGS) meta_body > $@
chmod -w $@
vhdl-elocations.adb: vhdl-elocations.adb.in vhdl-elocations.ads $(DEPS)
@@ -69,22 +71,22 @@ vhdl-elocations_meta.adb: vhdl-elocations_meta.adb.in vhdl-elocations.ads $(DEPS
python/libghdl/iirs.py: $(DEPS) $(PNODESPY)
$(RM) $@
- $(PNODESPY) libghdl-iirs > $@
+ $(PNODESPY) $(NODES_FLAGS) libghdl-iirs > $@
chmod -w $@
python/libghdl/nodes_meta.py: $(DEPS) $(PNODESPY)
$(RM) $@
- $(PNODESPY) libghdl-meta > $@
+ $(PNODESPY) $(NODES_FLAGS) libghdl-meta > $@
chmod -w $@
python/libghdl/std_names.py: $(PNODESPY) ../std_names.ads
$(RM) $@
- $(PNODESPY) libghdl-names > $@
+ $(PNODESPY) $(NODES_FLAGS) libghdl-names > $@
chmod -w $@
python/libghdl/tokens.py: $(PNODESPY) vhdl-tokens.ads
$(RM) $@
- $(PNODESPY) libghdl-tokens > $@
+ $(PNODESPY) $(NODES_FLAGS) libghdl-tokens > $@
chmod -w $@
python/libghdl/elocations.py: $(PNODESPY) vhdl-elocations.ads
diff --git a/src/vhdl/flists.ads b/src/vhdl/flists.ads
index 6c05d7695..3d43c0f74 100644
--- a/src/vhdl/flists.ads
+++ b/src/vhdl/flists.ads
@@ -16,7 +16,7 @@
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
with Types; use Types;
-with Nodes; use Nodes;
+with Vhdl.Nodes_Priv; use Vhdl.Nodes_Priv;
package Flists is
type Flist_Type is new Int32;
diff --git a/src/vhdl/iirs.adb b/src/vhdl/iirs.adb
index b41fd1e4d..4d800e1dd 100644
--- a/src/vhdl/iirs.adb
+++ b/src/vhdl/iirs.adb
@@ -15,13 +15,713 @@
-- 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 Nodes; use Nodes;
with Lists; use Lists;
with Nodes_Meta; use Nodes_Meta;
+with Vhdl.Nodes_Priv; use Vhdl.Nodes_Priv;
package body Iirs 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;
diff --git a/src/vhdl/iirs.adb.in b/src/vhdl/iirs.adb.in
index 293cd7254..dc0d9547b 100644
--- a/src/vhdl/iirs.adb.in
+++ b/src/vhdl/iirs.adb.in
@@ -15,13 +15,713 @@
-- 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 Nodes; use Nodes;
with Lists; use Lists;
with Nodes_Meta; use Nodes_Meta;
+with Vhdl.Nodes_Priv; use Vhdl.Nodes_Priv;
package body Iirs 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;
diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads
index e1226db1f..df5391e79 100644
--- a/src/vhdl/iirs.ads
+++ b/src/vhdl/iirs.ads
@@ -18,7 +18,7 @@
with Ada.Unchecked_Deallocation;
with Types; use Types;
with Vhdl.Tokens; use Vhdl.Tokens;
-with Nodes;
+with Vhdl.Nodes_Priv;
with Lists;
with Flists;
@@ -167,8 +167,8 @@ package Iirs is
-- Get the location of the node: ie the current position in the source
-- file when the node was created. This is a little bit fuzzy.
--
- -- procedure Set_Location (Target: in out Iir; Location: Location_Type);
- -- function Get_Location (Target: in out Iir) return Location_Type;
+ -- procedure Set_Location (Target : Iir; Location: Location_Type);
+ -- function Get_Location (Target : Iir) return Location_Type;
--
-- Copy a location from a node to another one.
-- procedure Location_Copy (Target: in out Iir; Src: in Iir);
@@ -5448,9 +5448,9 @@ package Iirs is
-- Nodes and lists.
- subtype Iir is Nodes.Node_Type;
+ subtype Iir is Vhdl.Nodes_Priv.Node_Type;
- Null_Iir : constant Iir := Nodes.Null_Node;
+ Null_Iir : constant Iir := 0;
-- Return True iff Node is null / not set.
function Is_Null (Node : Iir) return Boolean;
@@ -5460,9 +5460,11 @@ package Iirs is
function Is_Valid (Node : Iir) return Boolean;
pragma Inline (Is_Valid);
- function "=" (L, R : Iir) return Boolean renames Nodes."=";
+ function "=" (L, R : Iir) return Boolean renames Vhdl.Nodes_Priv."=";
- function Get_Last_Node return Iir renames Nodes.Get_Last_Node;
+ -- Get the last node allocated.
+ function Get_Last_Node return Iir;
+ pragma Inline (Get_Last_Node);
subtype Iir_List is Lists.List_Type;
Null_Iir_List : constant Iir_List := Lists.Null_List;
@@ -5847,20 +5849,23 @@ package Iirs is
function Get_Kind (N : Iir) return Iir_Kind;
pragma Inline (Get_Kind);
+ function Next_Node (N : Iir) return Iir;
+
-- Create a new IIR of kind NEW_KIND, and copy fields from SRC to this
-- iir. Src fields are cleaned.
--function Clone_Iir (Src: Iir; New_Kind : Iir_Kind) return Iir;
- procedure Set_Location (Target : Iir; Location : Location_Type)
- renames Nodes.Set_Location;
- function Get_Location (Target : Iir) return Location_Type
- renames Nodes.Get_Location;
+ procedure Set_Location (N : Iir; Location : Location_Type);
+ function Get_Location (N : Iir) return Location_Type;
procedure Location_Copy (Target : Iir; Src : Iir);
function Create_Iir (Kind : Iir_Kind) return Iir;
function Create_Iir_Error return Iir;
- procedure Free_Iir (Target : Iir) renames Nodes.Free_Node;
+ procedure Free_Iir (Target : Iir);
+
+ -- Free all and reinit.
+ procedure Initialize;
-- Disp statistics about node usage.
procedure Disp_Stats;
diff --git a/src/vhdl/nodes.adb b/src/vhdl/nodes.adb
deleted file mode 100644
index ef22fb028..000000000
--- a/src/vhdl/nodes.adb
+++ /dev/null
@@ -1,452 +0,0 @@
--- 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 Tables;
-
-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);
-
- 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 Node_Type 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;
-
- 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 : 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_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;
-
- 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;
-
- procedure Initialize is
- begin
- Nodet.Free;
- Nodet.Init;
- end Initialize;
-end Nodes;
diff --git a/src/vhdl/nodes.ads b/src/vhdl/nodes.ads
deleted file mode 100644
index b3fe3fd7d..000000000
--- a/src/vhdl/nodes.ads
+++ /dev/null
@@ -1,320 +0,0 @@
--- 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 Types; use Types;
-
-package Nodes is
- type Node_Type is new Int32;
- for Node_Type'Size use 32;
-
- Null_Node : constant Node_Type := 0;
- Error_Node : constant Node_Type := 1;
-
- -- A simple type that needs only 2 bits.
- type Bit2_Type is range 0 .. 2 ** 2 - 1;
- type Bit3_Type is range 0 .. 2 ** 3 - 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 Next_Node (N : Node_Type) return 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_Location (N: Node_Type) return Location_Type;
- pragma Inline (Get_Location);
- procedure Set_Location (N : Node_Type; Location: Location_Type);
- pragma Inline (Set_Location);
-
- 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);
-
- function Get_State4 (N : Node_Type) return Bit2_Type;
- pragma Inline (Get_State4);
- procedure Set_State4 (N : Node_Type; V : Bit2_Type);
- pragma Inline (Set_State4);
-
- -- Get the last node allocated.
- function Get_Last_Node return Node_Type;
- pragma Inline (Get_Last_Node);
-
- -- Free all and reinit.
- procedure Initialize;
-private
- 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);
-
-end Nodes;
diff --git a/src/vhdl/translate/trans.adb b/src/vhdl/translate/trans.adb
index b9455965d..9b0029205 100644
--- a/src/vhdl/translate/trans.adb
+++ b/src/vhdl/translate/trans.adb
@@ -17,7 +17,7 @@
-- 02111-1307, USA.
with Name_Table; -- use Name_Table;
-with Nodes;
+with Vhdl.Nodes_Priv;
with Tables;
with Trans_Decls; use Trans_Decls;
@@ -1368,11 +1368,11 @@ package body Trans is
procedure Update_Node_Infos
is
- use Nodes;
+ use Vhdl.Nodes_Priv;
F, L : Iir;
begin
F := Node_Infos.Last;
- L := Nodes.Get_Last_Node;
+ L := Get_Last_Node;
Node_Infos.Set_Last (L);
Node_Infos.Table (F + 1 .. L) := (others => null);
end Update_Node_Infos;
diff --git a/src/vhdl/vhdl-elocations.adb b/src/vhdl/vhdl-elocations.adb
index 50e775146..0ba3d0b0e 100644
--- a/src/vhdl/vhdl-elocations.adb
+++ b/src/vhdl/vhdl-elocations.adb
@@ -17,7 +17,7 @@
-- 02111-1307, USA.
with Tables;
-with Nodes;
+with Vhdl.Nodes_Priv;
with Vhdl.Elocations_Meta; use Vhdl.Elocations_Meta;
package body Vhdl.Elocations is
@@ -90,7 +90,7 @@ package body Vhdl.Elocations is
procedure Create_Elocations (N : Iir)
is
- use Nodes;
+ use Vhdl.Nodes_Priv;
Format : constant Format_Type := Get_Format (Get_Kind (N));
El : constant Iir := Elocations_Index_Table.Last;
Len : Location_Index_Type;
@@ -148,7 +148,7 @@ package body Vhdl.Elocations is
function Get_FieldX (N : Iir) return Location_Type
is
- use Nodes;
+ use Vhdl.Nodes_Priv;
Idx : Location_Index_Type;
begin
pragma Assert (N <= Elocations_Index_Table.Last);
@@ -158,7 +158,7 @@ package body Vhdl.Elocations is
procedure Set_FieldX (N : Iir; Loc : Location_Type)
is
- use Nodes;
+ use Vhdl.Nodes_Priv;
Idx : Location_Index_Type;
begin
pragma Assert (N <= Elocations_Index_Table.Last);
diff --git a/src/vhdl/vhdl-elocations.adb.in b/src/vhdl/vhdl-elocations.adb.in
index 1e2827b5f..80fab21ce 100644
--- a/src/vhdl/vhdl-elocations.adb.in
+++ b/src/vhdl/vhdl-elocations.adb.in
@@ -17,7 +17,7 @@
-- 02111-1307, USA.
with Tables;
-with Nodes;
+with Vhdl.Nodes_Priv;
with Vhdl.Elocations_Meta; use Vhdl.Elocations_Meta;
package body Vhdl.Elocations is
@@ -90,7 +90,7 @@ package body Vhdl.Elocations is
procedure Create_Elocations (N : Iir)
is
- use Nodes;
+ use Vhdl.Nodes_Priv;
Format : constant Format_Type := Get_Format (Get_Kind (N));
El : constant Iir := Elocations_Index_Table.Last;
Len : Location_Index_Type;
@@ -148,7 +148,7 @@ package body Vhdl.Elocations is
function Get_FieldX (N : Iir) return Location_Type
is
- use Nodes;
+ use Vhdl.Nodes_Priv;
Idx : Location_Index_Type;
begin
pragma Assert (N <= Elocations_Index_Table.Last);
@@ -158,7 +158,7 @@ package body Vhdl.Elocations is
procedure Set_FieldX (N : Iir; Loc : Location_Type)
is
- use Nodes;
+ use Vhdl.Nodes_Priv;
Idx : Location_Index_Type;
begin
pragma Assert (N <= Elocations_Index_Table.Last);
diff --git a/src/vhdl/vhdl-nodes_gc.adb b/src/vhdl/vhdl-nodes_gc.adb
index 8876528ff..d20f2a89e 100644
--- a/src/vhdl/vhdl-nodes_gc.adb
+++ b/src/vhdl/vhdl-nodes_gc.adb
@@ -19,7 +19,6 @@
with Ada.Unchecked_Deallocation;
with Types; use Types;
with Logging; use Logging;
-with Nodes;
with Nodes_Meta; use Nodes_Meta;
with Errorout; use Errorout;
with Libraries;
@@ -497,7 +496,7 @@ package body Vhdl.Nodes_GC is
Nbr_Unreferenced := Nbr_Unreferenced + 1;
Report_Unreferenced_Node (El);
end if;
- El := Iir (Nodes.Next_Node (Nodes.Node_Type (El)));
+ El := Next_Node (El);
end loop;
Free (Markers);
diff --git a/src/vhdl/vhdl-nodes_priv.ads b/src/vhdl/vhdl-nodes_priv.ads
new file mode 100644
index 000000000..b3bdee3fc
--- /dev/null
+++ b/src/vhdl/vhdl-nodes_priv.ads
@@ -0,0 +1,28 @@
+-- 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 Types; use Types;
+
+package Vhdl.Nodes_Priv is
+ pragma Preelaborate (Vhdl.Nodes_Priv);
+
+ type Node_Type is new Int32;
+ for Node_Type'Size use 32;
+
+ Null_Node : constant Node_Type := 0;
+ Error_Node : constant Node_Type := 1;
+end Vhdl.Nodes_Priv;
diff --git a/src/vhdl/vhdl-sem_inst.adb b/src/vhdl/vhdl-sem_inst.adb
index 8d73a7a2d..8550e0650 100644
--- a/src/vhdl/vhdl-sem_inst.adb
+++ b/src/vhdl/vhdl-sem_inst.adb
@@ -15,7 +15,7 @@
-- the original declaration are also stored in that table.
with Tables;
-with Nodes;
+with Vhdl.Nodes_Priv;
with Nodes_Meta;
with Types; use Types;
with Files_Map;
@@ -48,7 +48,7 @@ package body Vhdl.Sem_Inst is
procedure Expand_Origin_Table
is
- use Nodes;
+ use Vhdl.Nodes_Priv;
Last : constant Iir := Iirs.Get_Last_Node;
El : constant Iir := Origin_Table.Last;
begin
@@ -62,7 +62,7 @@ package body Vhdl.Sem_Inst is
function Get_Origin (N : Iir) return Iir
is
-- Make the '<=' operator visible.
- use Nodes;
+ use Vhdl.Nodes_Priv;
begin
if N <= Origin_Table.Last then
return Origin_Table.Table (N);
@@ -75,7 +75,7 @@ package body Vhdl.Sem_Inst is
function Get_Instance (N : Iir) return Iir
is
-- Make '<=' operator visible for the assert.
- use Nodes;
+ use Vhdl.Nodes_Priv;
begin
pragma Assert (N <= Origin_Table.Last);
return Origin_Table.Table (N);
@@ -120,7 +120,7 @@ package body Vhdl.Sem_Inst is
-- of ORIG is saved.
procedure Set_Instance (Orig : Iir; N : Iir)
is
- use Nodes;
+ use Vhdl.Nodes_Priv;
begin
pragma Assert (Orig <= Origin_Table.Last);
diff --git a/src/vhdl/vhdl-types.ads b/src/vhdl/vhdl-types.ads
new file mode 100644
index 000000000..18b9b2ccb
--- /dev/null
+++ b/src/vhdl/vhdl-types.ads
@@ -0,0 +1,24 @@
+-- Common types for vhdl.
+-- Copyright (C) 2019 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 Vhdl.Nodes_Priv;
+
+package Vhdl.Types is
+ pragma Preelaborate (Vhdl.Types);
+
+ subtype Node is Vhdl.Nodes_Priv.Node_Type;
+end Vhdl.Types;
diff --git a/src/vhdl/xrefs.adb b/src/vhdl/xrefs.adb
index 8b66339e2..d59b34f60 100644
--- a/src/vhdl/xrefs.adb
+++ b/src/vhdl/xrefs.adb
@@ -20,7 +20,7 @@ with GNAT.Heap_Sort_A;
with Flags;
with Vhdl.Std_Package;
with Errorout; use Errorout;
-with Nodes;
+with Vhdl.Nodes_Priv;
package body Xrefs is
type Xref_Type is record
@@ -220,7 +220,7 @@ package body Xrefs is
N1 := Get_Xref_Node (Op1);
N2 := Get_Xref_Node (Op2);
if Iirs."/=" (N1, N2) then
- return Nodes."<" (N1, N2);
+ return Vhdl.Nodes_Priv."<" (N1, N2);
end if;
-- Try to get declaration first.