nodes: handle 'grp' conversion, replace Odigit1 by flags.

6 files changed, 219 insertions, 121 deletions

diff --git a/src/vhdl/iirs.adb b/src/vhdl/iirs.adb
index 4f19470e6..53779d7a9 100644
--- a/src/vhdl/iirs.adb
+++ b/src/vhdl/iirs.adb
@@ -1032,20 +1032,42 @@ package body Iirs is
       Set_Field4 (Lit, Int32_To_Iir (Len));
    end Set_String_Length;
 
-   function Get_Bit_String_Base (Lit : Iir) return Number_Base_Type is
+   type Number_Base_Type_Conv is record
+      Flag12: Boolean;
+      Flag13: Boolean;
+      Flag14: Boolean;
+   end record;
+   pragma Pack (Number_Base_Type_Conv);
+   pragma Assert (Number_Base_Type_Conv'Size = Number_Base_Type'Size);
+
+   function Get_Bit_String_Base (Lit : Iir) return Number_Base_Type
+   is
+      function To_Number_Base_Type is new Ada.Unchecked_Conversion
+         (Number_Base_Type_Conv, Number_Base_Type);
+      Conv : Number_Base_Type_Conv;
    begin
       pragma Assert (Lit /= Null_Iir);
       pragma Assert (Has_Bit_String_Base (Get_Kind (Lit)),
                      "no field Bit_String_Base");
-      return Number_Base_Type'Val (Get_Odigit1 (Lit));
+      Conv.Flag12 := Get_Flag12 (Lit);
+      Conv.Flag13 := Get_Flag13 (Lit);
+      Conv.Flag14 := Get_Flag14 (Lit);
+      return To_Number_Base_Type (Conv);
    end Get_Bit_String_Base;
 
-   procedure Set_Bit_String_Base (Lit : Iir; Base : Number_Base_Type) is
+   procedure Set_Bit_String_Base (Lit : Iir; Base : Number_Base_Type)
+   is
+      function To_Number_Base_Type_Conv is new Ada.Unchecked_Conversion
+         (Number_Base_Type, Number_Base_Type_Conv);
+      Conv : Number_Base_Type_Conv;
    begin
       pragma Assert (Lit /= Null_Iir);
       pragma Assert (Has_Bit_String_Base (Get_Kind (Lit)),
                      "no field Bit_String_Base");
-      Set_Odigit1 (Lit, Number_Base_Type'Pos (Base));
+      Conv := To_Number_Base_Type_Conv (Base);
+      Set_Flag12 (Lit, Conv.Flag12);
+      Set_Flag13 (Lit, Conv.Flag13);
+      Set_Flag14 (Lit, Conv.Flag14);
    end Set_Bit_String_Base;
 
    function Get_Has_Signed (Lit : Iir) return Boolean is
@@ -1390,7 +1412,7 @@ package body Iirs is
       pragma Assert (Target /= Null_Iir);
       pragma Assert (Has_Open_Flag (Get_Kind (Target)),
                      "no field Open_Flag");
-      return Get_Flag12 (Target);
+      return Get_Flag15 (Target);
    end Get_Open_Flag;
 
    procedure Set_Open_Flag (Target : Iir; Flag : Boolean) is
@@ -1398,7 +1420,7 @@ package body Iirs is
       pragma Assert (Target /= Null_Iir);
       pragma Assert (Has_Open_Flag (Get_Kind (Target)),
                      "no field Open_Flag");
-      Set_Flag12 (Target, Flag);
+      Set_Flag15 (Target, Flag);
    end Set_Open_Flag;
 
    function Get_After_Drivers_Flag (Target : Iir) return Boolean is
@@ -2011,20 +2033,42 @@ package body Iirs is
       Set_Field1 (Target, Nature);
    end Set_Nature;
 
-   function Get_Mode (Target : Iir) return Iir_Mode is
+   type Iir_Mode_Conv is record
+      Flag12: Boolean;
+      Flag13: Boolean;
+      Flag14: Boolean;
+   end record;
+   pragma Pack (Iir_Mode_Conv);
+   pragma Assert (Iir_Mode_Conv'Size = Iir_Mode'Size);
+
+   function Get_Mode (Target : Iir) return Iir_Mode
+   is
+      function To_Iir_Mode is new Ada.Unchecked_Conversion
+         (Iir_Mode_Conv, Iir_Mode);
+      Conv : Iir_Mode_Conv;
    begin
       pragma Assert (Target /= Null_Iir);
       pragma Assert (Has_Mode (Get_Kind (Target)),
                      "no field Mode");
-      return Iir_Mode'Val (Get_Odigit1 (Target));
+      Conv.Flag12 := Get_Flag12 (Target);
+      Conv.Flag13 := Get_Flag13 (Target);
+      Conv.Flag14 := Get_Flag14 (Target);
+      return To_Iir_Mode (Conv);
    end Get_Mode;
 
-   procedure Set_Mode (Target : Iir; Mode : Iir_Mode) is
+   procedure Set_Mode (Target : Iir; Mode : Iir_Mode)
+   is
+      function To_Iir_Mode_Conv is new Ada.Unchecked_Conversion
+         (Iir_Mode, Iir_Mode_Conv);
+      Conv : Iir_Mode_Conv;
    begin
       pragma Assert (Target /= Null_Iir);
       pragma Assert (Has_Mode (Get_Kind (Target)),
                      "no field Mode");
-      Set_Odigit1 (Target, Iir_Mode'Pos (Mode));
+      Conv := To_Iir_Mode_Conv (Mode);
+      Set_Flag12 (Target, Conv.Flag12);
+      Set_Flag13 (Target, Conv.Flag13);
+      Set_Flag14 (Target, Conv.Flag14);
    end Set_Mode;
 
    function Get_Guarded_Signal_Flag (Target : Iir) return Boolean is
diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads
index af9c7478b..8a79629aa 100644
--- a/src/vhdl/iirs.ads
+++ b/src/vhdl/iirs.ads
@@ -314,7 +314,7 @@ package Iirs is
    --
    --  Base of the bit_string (corresponds to letters 'b', 'o', 'd' or 'x' in
    --  the base specifier).
-   --   Get/Set_Bit_String_Base (Odigit1)
+   --   Get/Set_Bit_String_Base (Flag12,Flag13,Flag14)
    --
    --   Get/Set_Expr_Staticness (State1)
    --
@@ -1215,7 +1215,7 @@ package Iirs is
    --  present for uniformity (and speed).
    --   Get/Set_Type (Field1)
    --
-   --   Get/Set_Mode (Odigit1)
+   --   Get/Set_Mode (Flag12,Flag13,Flag14)
    --
    -- Only for Iir_Kind_Interface_Signal_Declaration:
    --   Get/Set_Has_Disconnect_Flag (Flag1)
@@ -1244,7 +1244,7 @@ package Iirs is
    --   Get/Set_Has_Class (Flag11)
    --
    -- Only for Iir_Kind_Interface_Signal_Declaration:
-   --   Get/Set_Open_Flag (Flag12)
+   --   Get/Set_Open_Flag (Flag15)
    --
    --   Get/Set_Expr_Staticness (State1)
    --
@@ -1708,7 +1708,7 @@ package Iirs is
    --   Get/Set_File_Open_Kind (Field7)
    --
    --  This is used only in vhdl 87.
-   --   Get/Set_Mode (Odigit1)
+   --   Get/Set_Mode (Flag12,Flag13,Flag14)
    --
    --   Get/Set_Has_Identifier_List (Flag3)
    --
@@ -5757,7 +5757,7 @@ package Iirs is
    procedure Set_String_Length (Lit : Iir; Len : Int32);
 
    --  Base of a bit string.  Base_None for a string literal.
-   --  Field: Odigit1 (pos)
+   --  Field: Flag12,Flag13,Flag14 (grp)
    function Get_Bit_String_Base (Lit : Iir) return Number_Base_Type;
    procedure Set_Bit_String_Base (Lit : Iir; Base : Number_Base_Type);
 
@@ -5866,7 +5866,7 @@ package Iirs is
 
    --  This flag is set for a very short time during the check that no in
    --  port is unconnected.
-   --  Field: Flag12
+   --  Field: Flag15
    function Get_Open_Flag (Target : Iir) return Boolean;
    procedure Set_Open_Flag (Target : Iir; Flag : Boolean);
 
@@ -6061,7 +6061,7 @@ package Iirs is
    procedure Set_Nature (Target : Iir; Nature : Iir);
 
    --  Mode of interfaces or file (v87).
-   --  Field: Odigit1 (pos)
+   --  Field: Flag12,Flag13,Flag14 (grp)
    function Get_Mode (Target : Iir) return Iir_Mode;
    procedure Set_Mode (Target : Iir; Mode : Iir_Mode);
 
diff --git a/src/vhdl/nodes.adb b/src/vhdl/nodes.adb
index 884f9d69b..71ec38512 100644
--- a/src/vhdl/nodes.adb
+++ b/src/vhdl/nodes.adb
@@ -87,7 +87,6 @@ package body Nodes is
                  (Format => Format_Short,
                   Kind => 0,
                   State1 | State2 => 0,
-                  Odigit1 => 0,
                   Location => Location_Nil,
                   Field0 | Field1 | Field2 | Field3  => Null_Node,
                   Field4 | Field5 => Null_Node,
@@ -403,6 +402,36 @@ package body Nodes is
       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
@@ -444,28 +473,6 @@ package body Nodes is
       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;
diff --git a/src/vhdl/nodes.ads b/src/vhdl/nodes.ads
index f816a560b..d32c86673 100644
--- a/src/vhdl/nodes.ads
+++ b/src/vhdl/nodes.ads
@@ -52,10 +52,12 @@ package Nodes is
    --   Flag10 : Boolean
    --   Flag11 : Boolean
    --   Flag12 : Boolean
+   --   Flag13 : Boolean
+   --   Flag14 : Boolean
+   --   Flag15 : Boolean
    --   Nkind : Kind_Type
    --   State1 : Bit2_Type
    --   State2 : Bit2_Type
-   --   Odigit1 : Bit3_Type
    --   Location : Location_Type
    --   Field0 : Iir
    --   Field1 : Iir
@@ -73,7 +75,6 @@ package Nodes is
    --   Field5 : Iir
 
    -- Fields of Format_Medium:
-   --   Odigit2 : Bit3_Type (odigit1)
    --   State3 : Bit2_Type
    --   State4 : Bit2_Type
    --   Field4 : Iir
@@ -227,6 +228,21 @@ package Nodes is
    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);
@@ -248,18 +264,6 @@ package Nodes is
    procedure Set_State4 (N : Node_Type; V : Bit2_Type);
    pragma Inline (Set_State4);
 
-
-   function Get_Odigit1 (N : Node_Type) return Bit3_Type;
-   pragma Inline (Get_Odigit1);
-   procedure Set_Odigit1 (N : Node_Type; V : Bit3_Type);
-   pragma Inline (Set_Odigit1);
-
-   function Get_Odigit2 (N : Node_Type) return Bit3_Type;
-   pragma Inline (Get_Odigit2);
-   procedure Set_Odigit2 (N : Node_Type; V : Bit3_Type);
-   pragma Inline (Set_Odigit2);
-
-
    function Get_Fp64 (N : Node_Type) return Iir_Fp64;
    pragma Inline (Get_Fp64);
    procedure Set_Fp64 (N : Node_Type; V : Iir_Fp64);
@@ -278,26 +282,32 @@ package Nodes is
    procedure Initialize;
 private
    type Node_Record (Format : Format_Type := Format_Short) is record
+      --  First byte (with Format):
       Flag1 : Boolean := False;
       Flag2 : Boolean := False;
       Flag3 : Boolean := False;
       Flag4 : Boolean := False;
       Flag5 : Boolean := False;
       Flag6 : Boolean := False;
+
+      --  Second byte:
       Flag7 : Boolean := False;
       Flag8 : Boolean := False;
       Flag9 : Boolean := False;
       Flag10 : Boolean := False;
-
       Flag11 : Boolean := False;
       Flag12 : Boolean := False;
       Flag13 : Boolean := False;
       Flag14 : Boolean := False;
 
-      --  2*2 + 1*3 = 7 bits
+      --  Third byte:
+      Flag15 : Boolean := False;
+      Flag16 : Boolean := False;
+      Flag17 : Boolean := False;
+
+      --  2*2 = 4 bits
       State1 : Bit2_Type := 0;
       State2 : Bit2_Type := 0;
-      Odigit1 : Bit3_Type := 0;
 
       --  9 bits
       Kind : Kind_Type;
diff --git a/src/vhdl/nodes_meta.adb b/src/vhdl/nodes_meta.adb
index 6a4f27355..8198f3194 100644
--- a/src/vhdl/nodes_meta.adb
+++ b/src/vhdl/nodes_meta.adb
@@ -2276,9 +2276,9 @@ package body Nodes_Meta is
       Field_String_Length,
       Field_String8_Id,
       Field_Has_Signed,
+      Field_Bit_String_Base,
       Field_Has_Sign,
       Field_Has_Length,
-      Field_Bit_String_Base,
       Field_Expr_Staticness,
       Field_Literal_Origin,
       Field_Literal_Subtype,
@@ -3074,10 +3074,10 @@ package body Nodes_Meta is
       --  Iir_Kind_File_Declaration
       Field_Identifier,
       Field_Has_Mode,
+      Field_Mode,
       Field_Has_Identifier_List,
       Field_Visible_Flag,
       Field_Use_Flag,
-      Field_Mode,
       Field_Expr_Staticness,
       Field_Name_Staticness,
       Field_Parent,
@@ -3163,12 +3163,12 @@ package body Nodes_Meta is
       Field_Identifier,
       Field_Has_Mode,
       Field_Has_Class,
+      Field_Mode,
       Field_Has_Identifier_List,
       Field_Visible_Flag,
       Field_After_Drivers_Flag,
       Field_Use_Flag,
       Field_Is_Ref,
-      Field_Mode,
       Field_Expr_Staticness,
       Field_Name_Staticness,
       Field_Parent,
@@ -3180,12 +3180,12 @@ package body Nodes_Meta is
       Field_Identifier,
       Field_Has_Mode,
       Field_Has_Class,
+      Field_Mode,
       Field_Has_Identifier_List,
       Field_Visible_Flag,
       Field_After_Drivers_Flag,
       Field_Use_Flag,
       Field_Is_Ref,
-      Field_Mode,
       Field_Expr_Staticness,
       Field_Name_Staticness,
       Field_Parent,
@@ -3198,6 +3198,7 @@ package body Nodes_Meta is
       Field_Has_Disconnect_Flag,
       Field_Has_Mode,
       Field_Has_Class,
+      Field_Mode,
       Field_Open_Flag,
       Field_Has_Active_Flag,
       Field_Has_Identifier_List,
@@ -3207,7 +3208,6 @@ package body Nodes_Meta is
       Field_Is_Ref,
       Field_Guarded_Signal_Flag,
       Field_Signal_Kind,
-      Field_Mode,
       Field_Expr_Staticness,
       Field_Name_Staticness,
       Field_Parent,
@@ -3219,12 +3219,12 @@ package body Nodes_Meta is
       Field_Identifier,
       Field_Has_Mode,
       Field_Has_Class,
+      Field_Mode,
       Field_Has_Identifier_List,
       Field_Visible_Flag,
       Field_After_Drivers_Flag,
       Field_Use_Flag,
       Field_Is_Ref,
-      Field_Mode,
       Field_Expr_Staticness,
       Field_Name_Staticness,
       Field_Parent,
diff --git a/src/xtools/pnodes.py b/src/xtools/pnodes.py
index ce37556ea..243580de0 100755
--- a/src/xtools/pnodes.py
+++ b/src/xtools/pnodes.py
@@ -12,13 +12,13 @@ prefix_name = "Iir_Kind_"
 prefix_range_name = "Iir_Kinds_"
 type_name = "Iir_Kind"
 node_type = "Iir"
-conversions = ['uc', 'pos']
+conversions = ['uc', 'pos', 'grp']
 
 class FuncDesc:
-    def __init__(self, name, field, conv, acc,
+    def __init__(self, name, fields, conv, acc,
                  pname, ptype, rname, rtype):
         self.name = name
-        self.field = field
+        self.fields = fields  # List of physical fields used
         self.conv = conv
         self.acc = acc  # access: Chain, Chain_Next, Ref, Of_Ref, Maybe_Ref,
                         #         Forward_Ref, Maybe_Forward_Ref
@@ -229,9 +229,7 @@ def read_kinds(filename):
 
     # Read functions
     funcs = []
-    pat_field = re.compile(
-        '   --  Field: (\w+)'
-        + '( Of_Ref| Ref| Maybe_Ref| Forward_Ref| Maybe_Forward_Ref| Chain_Next| Chain)?( .*)?\n')
+    pat_field = re.compile('   --  Field: ([\w,]+)( \w+)?( \(\w+\))?\n')
     pat_conv = re.compile('^ \((\w+)\)$')
     pat_func = \
       re.compile('   function Get_(\w+) \((\w+) : (\w+)\) return (\w+);\n')
@@ -244,10 +242,12 @@ def read_kinds(filename):
             break
         m = pat_field.match(l)
         if m:
-            # Extract conversion
+            fields = m.group(1).split(',')
+            # Extract access modifier
             acc = m.group(2)
             if acc:
                 acc = acc.strip()
+            # Extract conversion
             conv = m.group(3)
             if conv:
                 mc = pat_conv.match(conv)
@@ -280,7 +280,7 @@ def read_kinds(filename):
                 raise ParseError(lr, 'parameter type mismatch with function')
             if mf.group(4) != mp.group(5):
                 raise ParseError(lr, 'result type mismatch with function')
-            funcs.append(FuncDesc(mf.group(1), m.group(1), conv, acc,
+            funcs.append(FuncDesc(mf.group(1), fields, conv, acc,
                                   mp.group(2), mp.group(3),
                                   mp.group(4), mp.group(5)))
 
@@ -291,7 +291,7 @@ def read_kinds(filename):
 #  (one description may describe several nodes).
 def read_nodes_fields(lr, names, fields, nodes, funcs_dict):
     pat_only = re.compile('   -- Only for ' + prefix_name + '(\w+):\n')
-    pat_field = re.compile('   --   Get/Set_(\w+) \((Alias )?(\w+)\)\n')
+    pat_field = re.compile('   --   Get/Set_(\w+) \((Alias )?([\w,]+)\)\n')
     pat_comment = re.compile('   --.*\n')
     pat_start = re.compile ('   --   \w.*\n')
 
@@ -326,21 +326,24 @@ def read_nodes_fields(lr, names, fields, nodes, funcs_dict):
             # 1) Check the function exists
             func = m.group(1)
             alias = m.group(2)
-            field = m.group(3)
+            fields = m.group(3).split(',')
             if func not in funcs_dict:
                 raise ParseError(lr, 'unknown function')
             func = funcs_dict[func]
-            if func.field != field:
-                raise ParseError(lr, 'field mismatch')
+            if func.fields != fields:
+                raise ParseError(lr, 'fields mismatch')
             for c in only_nodes:
-                if field not in c.fields:
-                    raise ParseError(lr, 'field ' + field + \
-                                     ' does not exist in node')
+                for f in fields:
+                    if f not in c.fields:
+                        raise ParseError(lr, 'field ' + f + \
+                                        ' does not exist in node')
                 if not alias:
-                    if c.fields[field]:
-                        raise ParseError(lr, 'field already used')
-                    c.fields[field] = func
-                    c.order.append(field)
+                    for f in fields:
+                        if c.fields[f]:
+                            raise ParseError \
+                              (lr, 'field ' + f + ' already used')
+                        c.fields[f] = func
+                        c.order.append(f)
                 c.attrs[func.name] = func
             only_nodes = cur_nodes
         elif pat_start.match(l):
@@ -450,36 +453,79 @@ def gen_assert(func):
         print '         ' + cond
         print '          ' + msg
 
+def get_field_type(fields, f):
+    for fld in fields.values():
+        if f in fld:
+            return fld[f]
+    return None
+
 # Generate Get_XXX/Set_XXX subprograms for FUNC.
 def gen_get_set(func, nodes, fields):
-    g = 'Get_' + func.field + ' (' + func.pname + ')'
+    rtype = func.rtype
+    # If the function needs several fields, it must be user defined
+    if func.conv == 'grp':
+        print '   type %s_Conv is record' % rtype
+        for f in func.fields:
+            print '      %s: %s;' % (f, get_field_type(fields, f))
+        print '   end record;'
+        print '   pragma Pack (%s_Conv);' % rtype
+        print "   pragma Assert (%s_Conv'Size = %s'Size);" % (rtype, rtype)
+        print
+    else:
+        f = func.fields[0]
+        g = 'Get_' + f + ' (' + func.pname + ')'
+
     s = func.rname
     if func.conv:
-        field_type = None
-        for fld in fields.values():
-            if func.field in fld:
-                field_type = fld[func.field]
-                break
         if func.conv == 'uc':
-            g = field_type + '_To_' + func.rtype + ' (' + g + ')'
-            s = func.rtype + '_To_' + field_type + ' (' + s + ')'
+            field_type = get_field_type(fields, f)
+            g = field_type + '_To_' + rtype + ' (' + g + ')'
+            s = rtype + '_To_' + field_type + ' (' + s + ')'
         elif func.conv == 'pos':
-            g = func.rtype + "'Val (" + g + ')'
-            s = func.rtype + "'Pos (" + s + ')'
+            g = rtype + "'Val (" + g + ')'
+            s = rtype + "'Pos (" + s + ')'
 
     subprg = '   function Get_' + func.name + ' (' + func.pname \
-          + ' : ' + func.ptype + ') return ' + func.rtype
-    gen_subprg_header(subprg)
+          + ' : ' + func.ptype + ') return ' + rtype
+    if func.conv == 'grp':
+        print subprg
+        print '   is'
+        print '      function To_%s is new Ada.Unchecked_Conversion' % \
+          func.rtype
+        print '         (%s_Conv, %s);' % (rtype, rtype);
+        print '      Conv : %s_Conv;' % rtype
+        print '   begin'
+    else:
+        gen_subprg_header(subprg)
     gen_assert(func)
+    if func.conv == 'grp':
+        for f in func.fields:
+            print '      Conv.%s := Get_%s (%s);' % (f, f, func.pname)
+        g = 'To_%s (Conv)' % rtype
     print '      return ' + g + ';'
     print '   end Get_' + func.name + ';'
     print
+
     subprg =  '   procedure Set_' + func.name + ' (' \
           + func.pname + ' : ' + func.ptype + '; ' \
           + func.rname + ' : ' + func.rtype + ')'
-    gen_subprg_header(subprg)
+    if func.conv == 'grp':
+        print subprg
+        print '   is'
+        print '      function To_%s_Conv is new Ada.Unchecked_Conversion' % \
+          func.rtype
+        print '         (%s, %s_Conv);' % (rtype, rtype);
+        print '      Conv : %s_Conv;' % rtype
+        print '   begin'
+    else:
+        gen_subprg_header(subprg)
     gen_assert(func)
-    print '      Set_' + func.field + ' (' + func.pname + ', ' + s + ');'
+    if func.conv == 'grp':
+        print '      Conv := To_%s_Conv (%s);' % (rtype, func.rname)
+        for f in func.fields:
+            print '      Set_%s (%s, Conv.%s);' % (f, func.pname, f)
+    else:
+        print '      Set_' + f + ' (' + func.pname + ', ' + s + ');'
     print '   end Set_' + func.name + ';'
     print
 
@@ -666,45 +712,35 @@ elif args.action == 'meta_body':
         elif l == '      --  FIELDS_ARRAY':
             last = None
             nodes_types = [node_type, node_type + '_List']
-            ref_names = ['Ref', 'Of_Ref', 'Maybe_Ref', 'Forward_Ref',
-                         'Maybe_Forward_Ref']
             for k in kinds:
                 v = nodes[k]
                 if last:
                     print last + ','
                 last = None
                 print '      --  ' + prefix_name + k
+                # Get list of physical fields for V, in some order.
                 if flag_keep_order:
                     flds = v.order
-                elif True:
-                    # first non Iir and no Iir_List
-                    flds = sorted([fk for fk, fv in v.fields.items() \
+                else:
+                    # First non Iir and no Iir_List.
+                    flds = sorted([fk for fk, fv in v.fields.items()
                                    if fv and fv.rtype not in nodes_types])
                     # Then Iir and Iir_List in order of appearance
                     flds += (fv for fv in v.order
                               if v.fields[fv].rtype in nodes_types)
-                else:
-                    # Sort fields: first non Iir and non Iir_List,
-                    #              then Iir and Iir_List that aren't references
-                    #              then Maybe_Ref
-                    #              then Ref and Ref_Of
-                    flds = sorted([fk for fk, fv in v.fields.items() \
-                                   if fv and fv.rtype not in nodes_types])
-                    flds += sorted([fk for fk, fv in v.fields.items() \
-                                    if fv and fv.rtype in nodes_types \
-                                    and fv.acc not in ref_names])
-                    flds += sorted([fk for fk, fv in v.fields.items() \
-                                    if fv and fv.rtype in nodes_types\
-                                    and fv.acc in ['Maybe_Ref']])
-                    flds += sorted([fk for fk, fv in v.fields.items() \
-                                    if fv and fv.rtype in nodes_types\
-                                    and fv.acc in ['Ref', 'Of_Ref',
-                                                   'Forward_Ref',
-                                                   'Maybe_Forward_Ref']])
+                # Print the corresponding node field, but remove duplicate due
+                # to 'grp'.
+                fldsn = []
                 for fk in flds:
                     if last:
                         print last + ','
-                    last = '      Field_' + v.fields[fk].name
+                    # Remove duplicate
+                    fn = v.fields[fk].name
+                    if fn not in fldsn:
+                        last = '      Field_' + fn
+                        fldsn.append(fn)
+                    else:
+                        last = None
             if last:
                 print last
         elif l == '      --  FIELDS_ARRAY_POS':
@@ -712,7 +748,8 @@ elif args.action == 'meta_body':
             last = None
             for k in kinds:
                 v = nodes[k]
-                flds = [fk for fk, fv in v.fields.items() if fv]
+                # Create a set to remove duplicate for 'grp'.
+                flds = set([fv.name for fk, fv in v.fields.items() if fv])
                 pos += len(flds)
                 if last:
                     print last + ','