diff options
Diffstat (limited to 'src/vhdl')
| -rw-r--r-- | src/vhdl/iirs.adb | 64 | ||||
| -rw-r--r-- | src/vhdl/iirs.ads | 14 | ||||
| -rw-r--r-- | src/vhdl/nodes.adb | 53 | ||||
| -rw-r--r-- | src/vhdl/nodes.ads | 44 | ||||
| -rw-r--r-- | src/vhdl/nodes_meta.adb | 12 |
5 files changed, 124 insertions, 63 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, |