diff options
| -rw-r--r-- | src/ghdldrv/ghdlprint.adb | 1 | ||||
| -rw-r--r-- | src/vhdl/iirs.adb | 46 | ||||
| -rw-r--r-- | src/vhdl/iirs.ads | 55 | ||||
| -rw-r--r-- | src/vhdl/nodes_meta.adb | 503 | ||||
| -rw-r--r-- | src/vhdl/nodes_meta.ads | 6 | ||||
| -rw-r--r-- | src/vhdl/parse.adb | 224 | ||||
| -rw-r--r-- | src/vhdl/scanner.adb | 352 | ||||
| -rw-r--r-- | src/vhdl/sem_expr.adb | 76 | ||||
| -rw-r--r-- | src/vhdl/tokens.adb | 3 | ||||
| -rw-r--r-- | src/vhdl/tokens.ads | 9 |
10 files changed, 878 insertions, 397 deletions
diff --git a/src/ghdldrv/ghdlprint.adb b/src/ghdldrv/ghdlprint.adb index 1ab1cad..d4e0f5f 100644 --- a/src/ghdldrv/ghdlprint.adb +++ b/src/ghdldrv/ghdlprint.adb @@ -434,6 +434,7 @@ package body Ghdlprint is | Tok_Comma .. Tok_Dot | Tok_Equal_Equal | Tok_Integer + | Tok_Integer_Letter | Tok_Real | Tok_Equal .. Tok_Slash | Tok_Invalid => diff --git a/src/vhdl/iirs.adb b/src/vhdl/iirs.adb index 1462bb3..6864213 100644 --- a/src/vhdl/iirs.adb +++ b/src/vhdl/iirs.adb @@ -903,16 +903,58 @@ package body Iirs is begin pragma Assert (Lit /= Null_Iir); pragma Assert (Has_Bit_String_Base (Get_Kind (Lit))); - return Base_Type'Val (Get_State2 (Lit)); + return Base_Type'Val (Get_Odigit1 (Lit)); end Get_Bit_String_Base; procedure Set_Bit_String_Base (Lit : Iir; Base : Base_Type) is begin pragma Assert (Lit /= Null_Iir); pragma Assert (Has_Bit_String_Base (Get_Kind (Lit))); - Set_State2 (Lit, Base_Type'Pos (Base)); + Set_Odigit1 (Lit, Base_Type'Pos (Base)); end Set_Bit_String_Base; + function Get_Has_Signed (Lit : Iir) return Boolean is + begin + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_Has_Signed (Get_Kind (Lit))); + return Get_Flag1 (Lit); + end Get_Has_Signed; + + procedure Set_Has_Signed (Lit : Iir; Flag : Boolean) is + begin + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_Has_Signed (Get_Kind (Lit))); + Set_Flag1 (Lit, Flag); + end Set_Has_Signed; + + function Get_Has_Sign (Lit : Iir) return Boolean is + begin + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_Has_Sign (Get_Kind (Lit))); + return Get_Flag2 (Lit); + end Get_Has_Sign; + + procedure Set_Has_Sign (Lit : Iir; Flag : Boolean) is + begin + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_Has_Sign (Get_Kind (Lit))); + Set_Flag2 (Lit, Flag); + end Set_Has_Sign; + + function Get_Has_Length (Lit : Iir) return Boolean is + begin + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_Has_Length (Get_Kind (Lit))); + return Get_Flag3 (Lit); + end Get_Has_Length; + + procedure Set_Has_Length (Lit : Iir; Flag : Boolean) is + begin + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_Has_Length (Get_Kind (Lit))); + Set_Flag3 (Lit, Flag); + end Set_Has_Length; + function Get_Literal_Origin (Lit : Iir) return Iir is begin pragma Assert (Lit /= Null_Iir); diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads index 6d3c45a..0387f27 100644 --- a/src/vhdl/iirs.ads +++ b/src/vhdl/iirs.ads @@ -284,9 +284,21 @@ package Iirs is -- -- Get/Set_String8_Id (Field5) -- - -- Get/Set_Bit_String_Base (State2) + -- 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_Expr_Staticness (State1) + -- + -- True if the bit string is signed, (ie letter 's' is present in the base + -- specifier). + -- Get/Set_Has_Signed (Flag1) + -- + -- True if the letter 'u' is present in the base specifier. + -- Get/Set_Has_Sign (Flag2) + -- + -- True if the integer specifying the length is present. + -- Get/Set_Has_Length (Flag3) -- Iir_Kind_Integer_Literal (Int) -- @@ -4579,7 +4591,7 @@ package Iirs is -- Purity depth of an impure subprogram. Iir_Depth_Impure : constant Iir_Int32 := -1; - type Base_Type is (Base_None, Base_2, Base_8, Base_16); + type Base_Type is (Base_None, Base_2, Base_8, Base_10, Base_16); -- design file subtype Iir_Design_File is Iir; @@ -5028,11 +5040,36 @@ package Iirs is function Get_Simple_Aggregate_List (Target : Iir) return Iir_List; procedure Set_Simple_Aggregate_List (Target : Iir; List : Iir_List); - -- Base of a bit string. - -- Field: State2 (pos) + -- For a string literal: the string identifier. + -- Field: Field5 (uc) + function Get_String8_Id (Lit : Iir) return String8_Id; + procedure Set_String8_Id (Lit : Iir; Id : String8_Id); + + -- For a string literal: the string length. + -- Field: Field4 (uc) + function Get_String_Length (Lit : Iir) return Int32; + procedure Set_String_Length (Lit : Iir; Len : Int32); + + -- Base of a bit string. Base_None for a string literal. + -- Field: Odigit1 (pos) function Get_Bit_String_Base (Lit : Iir) return Base_Type; procedure Set_Bit_String_Base (Lit : Iir; Base : Base_Type); + -- Bit string is signed. + -- Field: Flag1 + function Get_Has_Signed (Lit : Iir) return Boolean; + procedure Set_Has_Signed (Lit : Iir; Flag : Boolean); + + -- Bit string sign is explicit + -- Field: Flag2 + function Get_Has_Sign (Lit : Iir) return Boolean; + procedure Set_Has_Sign (Lit : Iir; Flag : Boolean); + + -- Bit string length is explicit + -- Field: Flag3 + function Get_Has_Length (Lit : Iir) return Boolean; + procedure Set_Has_Length (Lit : Iir; Flag : Boolean); + -- The origin of a literal can be null_iir for a literal generated by the -- parser, or a node which was statically evaluated to this literal. -- Such nodes are created by eval_expr. @@ -6232,16 +6269,6 @@ package Iirs is function Get_End_Location (Target : Iir) return Location_Type; procedure Set_End_Location (Target : Iir; Loc : Location_Type); - -- For a string literal: the string identifier. - -- Field: Field5 (uc) - function Get_String8_Id (Lit : Iir) return String8_Id; - procedure Set_String8_Id (Lit : Iir; Id : String8_Id); - - -- For a string literal: the string length. - -- Field: Field4 (uc) - function Get_String_Length (Lit : Iir) return Int32; - procedure Set_String_Length (Lit : Iir; Len : Int32); - -- For a declaration: true if the declaration is used somewhere. -- Field: Flag6 function Get_Use_Flag (Decl : Iir) return Boolean; diff --git a/src/vhdl/nodes_meta.adb b/src/vhdl/nodes_meta.adb index 9890310..62a8935 100644 --- a/src/vhdl/nodes_meta.adb +++ b/src/vhdl/nodes_meta.adb @@ -49,6 +49,9 @@ package body Nodes_Meta is Field_Fp_Value => Type_Iir_Fp64, Field_Simple_Aggregate_List => Type_Iir_List, Field_Bit_String_Base => Type_Base_Type, + Field_Has_Signed => Type_Boolean, + Field_Has_Sign => Type_Boolean, + Field_Has_Length => Type_Boolean, Field_Literal_Origin => Type_Iir, Field_Range_Origin => Type_Iir, Field_Literal_Subtype => Type_Iir, @@ -373,6 +376,12 @@ package body Nodes_Meta is return "simple_aggregate_list"; when Field_Bit_String_Base => return "bit_string_base"; + when Field_Has_Signed => + return "has_signed"; + when Field_Has_Sign => + return "has_sign"; + when Field_Has_Length => + return "has_length"; when Field_Literal_Origin => return "literal_origin"; when Field_Range_Origin => @@ -1427,6 +1436,12 @@ package body Nodes_Meta is return Attr_None; when Field_Bit_String_Base => return Attr_None; + when Field_Has_Signed => + return Attr_None; + when Field_Has_Sign => + return Attr_None; + when Field_Has_Length => + return Attr_None; when Field_Literal_Origin => return Attr_None; when Field_Range_Origin => @@ -2004,8 +2019,11 @@ package body Nodes_Meta is -- Iir_Kind_String_Literal8 Field_String_Length, Field_String8_Id, - Field_Expr_Staticness, + Field_Has_Signed, + Field_Has_Sign, + Field_Has_Length, Field_Bit_String_Base, + Field_Expr_Staticness, Field_Literal_Origin, Field_Literal_Subtype, Field_Type, @@ -3789,234 +3807,234 @@ package body Nodes_Meta is Iir_Kind_Integer_Literal => 45, Iir_Kind_Floating_Point_Literal => 49, Iir_Kind_Null_Literal => 51, - Iir_Kind_String_Literal8 => 58, - Iir_Kind_Physical_Int_Literal => 63, - Iir_Kind_Physical_Fp_Literal => 68, - Iir_Kind_Simple_Aggregate => 73, - Iir_Kind_Overflow_Literal => 76, - Iir_Kind_Waveform_Element => 79, - Iir_Kind_Conditional_Waveform => 82, - Iir_Kind_Association_Element_By_Expression => 89, - Iir_Kind_Association_Element_By_Individual => 95, - Iir_Kind_Association_Element_Open => 100, - Iir_Kind_Association_Element_Package => 106, - Iir_Kind_Choice_By_Others => 111, - Iir_Kind_Choice_By_Expression => 118, - Iir_Kind_Choice_By_Range => 125, - Iir_Kind_Choice_By_None => 130, - Iir_Kind_Choice_By_Name => 136, - Iir_Kind_Entity_Aspect_Entity => 138, - Iir_Kind_Entity_Aspect_Configuration => 139, - Iir_Kind_Entity_Aspect_Open => 139, - Iir_Kind_Block_Configuration => 145, - Iir_Kind_Block_Header => 149, - Iir_Kind_Component_Configuration => 155, - Iir_Kind_Binding_Indication => 161, - Iir_Kind_Entity_Class => 163, - Iir_Kind_Attribute_Value => 171, - Iir_Kind_Signature => 174, - Iir_Kind_Aggregate_Info => 181, - Iir_Kind_Procedure_Call => 185, - Iir_Kind_Record_Element_Constraint => 191, - Iir_Kind_Array_Element_Resolution => 192, - Iir_Kind_Record_Resolution => 193, - Iir_Kind_Record_Element_Resolution => 196, - Iir_Kind_Attribute_Specification => 204, - Iir_Kind_Disconnection_Specification => 209, - Iir_Kind_Configuration_Specification => 214, - Iir_Kind_Access_Type_Definition => 221, - Iir_Kind_Incomplete_Type_Definition => 228, - Iir_Kind_File_Type_Definition => 235, - Iir_Kind_Protected_Type_Declaration => 244, - Iir_Kind_Record_Type_Definition => 254, - Iir_Kind_Array_Type_Definition => 266, - Iir_Kind_Array_Subtype_Definition => 281, - Iir_Kind_Record_Subtype_Definition => 292, - Iir_Kind_Access_Subtype_Definition => 300, - Iir_Kind_Physical_Subtype_Definition => 309, - Iir_Kind_Floating_Subtype_Definition => 319, - Iir_Kind_Integer_Subtype_Definition => 328, - Iir_Kind_Enumeration_Subtype_Definition => 337, - Iir_Kind_Enumeration_Type_Definition => 346, - Iir_Kind_Integer_Type_Definition => 352, - Iir_Kind_Floating_Type_Definition => 358, - Iir_Kind_Physical_Type_Definition => 367, - Iir_Kind_Range_Expression => 373, - Iir_Kind_Protected_Type_Body => 380, - Iir_Kind_Subtype_Definition => 384, - Iir_Kind_Scalar_Nature_Definition => 388, - Iir_Kind_Overload_List => 389, - Iir_Kind_Type_Declaration => 395, - Iir_Kind_Anonymous_Type_Declaration => 400, - Iir_Kind_Subtype_Declaration => 408, - Iir_Kind_Nature_Declaration => 414, - Iir_Kind_Subnature_Declaration => 420, - Iir_Kind_Package_Declaration => 430, - Iir_Kind_Package_Instantiation_Declaration => 441, - Iir_Kind_Package_Body => 448, - Iir_Kind_Configuration_Declaration => 457, - Iir_Kind_Entity_Declaration => 469, - Iir_Kind_Architecture_Body => 481, - Iir_Kind_Package_Header => 483, - Iir_Kind_Unit_Declaration => 492, - Iir_Kind_Library_Declaration => 499, - Iir_Kind_Component_Declaration => 509, - Iir_Kind_Attribute_Declaration => 516, - Iir_Kind_Group_Template_Declaration => 522, - Iir_Kind_Group_Declaration => 529, - Iir_Kind_Element_Declaration => 536, - Iir_Kind_Non_Object_Alias_Declaration => 544, - Iir_Kind_Psl_Declaration => 552, - Iir_Kind_Terminal_Declaration => 558, - Iir_Kind_Free_Quantity_Declaration => 567, - Iir_Kind_Across_Quantity_Declaration => 579, - Iir_Kind_Through_Quantity_Declaration => 591, - Iir_Kind_Enumeration_Literal => 602, - Iir_Kind_Function_Declaration => 626, - Iir_Kind_Procedure_Declaration => 648, - Iir_Kind_Function_Body => 658, - Iir_Kind_Procedure_Body => 668, - Iir_Kind_Object_Alias_Declaration => 680, - Iir_Kind_File_Declaration => 695, - Iir_Kind_Guard_Signal_Declaration => 708, - Iir_Kind_Signal_Declaration => 725, - Iir_Kind_Variable_Declaration => 738, - Iir_Kind_Constant_Declaration => 752, - Iir_Kind_Iterator_Declaration => 764, - Iir_Kind_Interface_Constant_Declaration => 780, - Iir_Kind_Interface_Variable_Declaration => 796, - Iir_Kind_Interface_Signal_Declaration => 817, - Iir_Kind_Interface_File_Declaration => 833, - Iir_Kind_Interface_Package_Declaration => 842, - Iir_Kind_Identity_Operator => 846, - Iir_Kind_Negation_Operator => 850, - Iir_Kind_Absolute_Operator => 854, - Iir_Kind_Not_Operator => 858, - Iir_Kind_Condition_Operator => 862, - Iir_Kind_Reduction_And_Operator => 866, - Iir_Kind_Reduction_Or_Operator => 870, - Iir_Kind_Reduction_Nand_Operator => 874, - Iir_Kind_Reduction_Nor_Operator => 878, - Iir_Kind_Reduction_Xor_Operator => 882, - Iir_Kind_Reduction_Xnor_Operator => 886, - Iir_Kind_And_Operator => 891, - Iir_Kind_Or_Operator => 896, - Iir_Kind_Nand_Operator => 901, - Iir_Kind_Nor_Operator => 906, - Iir_Kind_Xor_Operator => 911, - Iir_Kind_Xnor_Operator => 916, - Iir_Kind_Equality_Operator => 921, - Iir_Kind_Inequality_Operator => 926, - Iir_Kind_Less_Than_Operator => 931, - Iir_Kind_Less_Than_Or_Equal_Operator => 936, - Iir_Kind_Greater_Than_Operator => 941, - Iir_Kind_Greater_Than_Or_Equal_Operator => 946, - Iir_Kind_Match_Equality_Operator => 951, - Iir_Kind_Match_Inequality_Operator => 956, - Iir_Kind_Match_Less_Than_Operator => 961, - Iir_Kind_Match_Less_Than_Or_Equal_Operator => 966, - Iir_Kind_Match_Greater_Than_Operator => 971, - Iir_Kind_Match_Greater_Than_Or_Equal_Operator => 976, - Iir_Kind_Sll_Operator => 981, - Iir_Kind_Sla_Operator => 986, - Iir_Kind_Srl_Operator => 991, - Iir_Kind_Sra_Operator => 996, - Iir_Kind_Rol_Operator => 1001, - Iir_Kind_Ror_Operator => 1006, - Iir_Kind_Addition_Operator => 1011, - Iir_Kind_Substraction_Operator => 1016, - Iir_Kind_Concatenation_Operator => 1021, - Iir_Kind_Multiplication_Operator => 1026, - Iir_Kind_Division_Operator => 1031, - Iir_Kind_Modulus_Operator => 1036, - Iir_Kind_Remainder_Operator => 1041, - Iir_Kind_Exponentiation_Operator => 1046, - Iir_Kind_Function_Call => 1054, - Iir_Kind_Aggregate => 1060, - Iir_Kind_Parenthesis_Expression => 1063, - Iir_Kind_Qualified_Expression => 1067, - Iir_Kind_Type_Conversion => 1072, - Iir_Kind_Allocator_By_Expression => 1076, - Iir_Kind_Allocator_By_Subtype => 1080, - Iir_Kind_Selected_Element => 1086, - Iir_Kind_Dereference => 1091, - Iir_Kind_Implicit_Dereference => 1096, - Iir_Kind_Slice_Name => 1103, - Iir_Kind_Indexed_Name => 1109, - Iir_Kind_Psl_Expression => 1111, - Iir_Kind_Sensitized_Process_Statement => 1130, - Iir_Kind_Process_Statement => 1148, - Iir_Kind_Concurrent_Conditional_Signal_Assignment => 1159, - Iir_Kind_Concurrent_Selected_Signal_Assignment => 1171, - Iir_Kind_Concurrent_Assertion_Statement => 1179, - Iir_Kind_Psl_Default_Clock => 1183, - Iir_Kind_Psl_Assert_Statement => 1192, - Iir_Kind_Psl_Cover_Statement => 1201, - Iir_Kind_Concurrent_Procedure_Call_Statement => 1207, - Iir_Kind_Block_Statement => 1220, - Iir_Kind_Generate_Statement => 1232, - Iir_Kind_Component_Instantiation_Statement => 1242, - Iir_Kind_Simple_Simultaneous_Statement => 1249, - Iir_Kind_Signal_Assignment_Statement => 1258, - Iir_Kind_Null_Statement => 1262, - Iir_Kind_Assertion_Statement => 1269, - Iir_Kind_Report_Statement => 1275, - Iir_Kind_Wait_Statement => 1282, - Iir_Kind_Variable_Assignment_Statement => 1288, - Iir_Kind_Return_Statement => 1294, - Iir_Kind_For_Loop_Statement => 1302, - Iir_Kind_While_Loop_Statement => 1309, - Iir_Kind_Next_Statement => 1315, - Iir_Kind_Exit_Statement => 1321, - Iir_Kind_Case_Statement => 1328, - Iir_Kind_Procedure_Call_Statement => 1333, - Iir_Kind_If_Statement => 1341, - Iir_Kind_Elsif => 1346, - Iir_Kind_Character_Literal => 1353, - Iir_Kind_Simple_Name => 1360, - Iir_Kind_Selected_Name => 1368, - Iir_Kind_Operator_Symbol => 1373, - Iir_Kind_Selected_By_All_Name => 1378, - Iir_Kind_Parenthesis_Name => 1382, - Iir_Kind_Base_Attribute => 1384, - Iir_Kind_Left_Type_Attribute => 1389, - Iir_Kind_Right_Type_Attribute => 1394, - Iir_Kind_High_Type_Attribute => 1399, - Iir_Kind_Low_Type_Attribute => 1404, - Iir_Kind_Ascending_Type_Attribute => 1409, - Iir_Kind_Image_Attribute => 1415, - Iir_Kind_Value_Attribute => 1421, - Iir_Kind_Pos_Attribute => 1427, - Iir_Kind_Val_Attribute => 1433, - Iir_Kind_Succ_Attribute => 1439, - Iir_Kind_Pred_Attribute => 1445, - Iir_Kind_Leftof_Attribute => 1451, - Iir_Kind_Rightof_Attribute => 1457, - Iir_Kind_Delayed_Attribute => 1465, - Iir_Kind_Stable_Attribute => 1473, - Iir_Kind_Quiet_Attribute => 1481, - Iir_Kind_Transaction_Attribute => 1489, - Iir_Kind_Event_Attribute => 1493, - Iir_Kind_Active_Attribute => 1497, - Iir_Kind_Last_Event_Attribute => 1501, - Iir_Kind_Last_Active_Attribute => 1505, - Iir_Kind_Last_Value_Attribute => 1509, - Iir_Kind_Driving_Attribute => 1513, - Iir_Kind_Driving_Value_Attribute => 1517, - Iir_Kind_Behavior_Attribute => 1517, - Iir_Kind_Structure_Attribute => 1517, - Iir_Kind_Simple_Name_Attribute => 1524, - Iir_Kind_Instance_Name_Attribute => 1529, - Iir_Kind_Path_Name_Attribute => 1534, - Iir_Kind_Left_Array_Attribute => 1541, - Iir_Kind_Right_Array_Attribute => 1548, - Iir_Kind_High_Array_Attribute => 1555, - Iir_Kind_Low_Array_Attribute => 1562, - Iir_Kind_Length_Array_Attribute => 1569, - Iir_Kind_Ascending_Array_Attribute => 1576, - Iir_Kind_Range_Array_Attribute => 1583, - Iir_Kind_Reverse_Range_Array_Attribute => 1590, - Iir_Kind_Attribute_Name => 1598 + Iir_Kind_String_Literal8 => 61, + Iir_Kind_Physical_Int_Literal => 66, + Iir_Kind_Physical_Fp_Literal => 71, + Iir_Kind_Simple_Aggregate => 76, + Iir_Kind_Overflow_Literal => 79, + Iir_Kind_Waveform_Element => 82, + Iir_Kind_Conditional_Waveform => 85, + Iir_Kind_Association_Element_By_Expression => 92, + Iir_Kind_Association_Element_By_Individual => 98, + Iir_Kind_Association_Element_Open => 103, + Iir_Kind_Association_Element_Package => 109, + Iir_Kind_Choice_By_Others => 114, + Iir_Kind_Choice_By_Expression => 121, + Iir_Kind_Choice_By_Range => 128, + Iir_Kind_Choice_By_None => 133, + Iir_Kind_Choice_By_Name => 139, + Iir_Kind_Entity_Aspect_Entity => 141, + Iir_Kind_Entity_Aspect_Configuration => 142, + Iir_Kind_Entity_Aspect_Open => 142, + Iir_Kind_Block_Configuration => 148, + Iir_Kind_Block_Header => 152, + Iir_Kind_Component_Configuration => 158, + Iir_Kind_Binding_Indication => 164, + Iir_Kind_Entity_Class => 166, + Iir_Kind_Attribute_Value => 174, + Iir_Kind_Signature => 177, + Iir_Kind_Aggregate_Info => 184, + Iir_Kind_Procedure_Call => 188, + Iir_Kind_Record_Element_Constraint => 194, + Iir_Kind_Array_Element_Resolution => 195, + Iir_Kind_Record_Resolution => 196, + Iir_Kind_Record_Element_Resolution => 199, + Iir_Kind_Attribute_Specification => 207, + Iir_Kind_Disconnection_Specification => 212, + Iir_Kind_Configuration_Specification => 217, + Iir_Kind_Access_Type_Definition => 224, + Iir_Kind_Incomplete_Type_Definition => 231, + Iir_Kind_File_Type_Definition => 238, + Iir_Kind_Protected_Type_Declaration => 247, + Iir_Kind_Record_Type_Definition => 257, + Iir_Kind_Array_Type_Definition => 269, + Iir_Kind_Array_Subtype_Definition => 284, + Iir_Kind_Record_Subtype_Definition => 295, + Iir_Kind_Access_Subtype_Definition => 303, + Iir_Kind_Physical_Subtype_Definition => 312, + Iir_Kind_Floating_Subtype_Definition => 322, + Iir_Kind_Integer_Subtype_Definition => 331, + Iir_Kind_Enumeration_Subtype_Definition => 340, + Iir_Kind_Enumeration_Type_Definition => 349, + Iir_Kind_Integer_Type_Definition => 355, + Iir_Kind_Floating_Type_Definition => 361, + Iir_Kind_Physical_Type_Definition => 370, + Iir_Kind_Range_Expression => 376, + Iir_Kind_Protected_Type_Body => 383, + Iir_Kind_Subtype_Definition => 387, + Iir_Kind_Scalar_Nature_Definition => 391, + Iir_Kind_Overload_List => 392, + Iir_Kind_Type_Declaration => 398, + Iir_Kind_Anonymous_Type_Declaration => 403, + Iir_Kind_Subtype_Declaration => 411, + Iir_Kind_Nature_Declaration => 417, + Iir_Kind_Subnature_Declaration => 423, + Iir_Kind_Package_Declaration => 433, + Iir_Kind_Package_Instantiation_Declaration => 444, + Iir_Kind_Package_Body => 451, + Iir_Kind_Configuration_Declaration => 460, + Iir_Kind_Entity_Declaration => 472, + Iir_Kind_Architecture_Body => 484, + Iir_Kind_Package_Header => 486, + Iir_Kind_Unit_Declaration => 495, + Iir_Kind_Library_Declaration => 502, + Iir_Kind_Component_Declaration => 512, + Iir_Kind_Attribute_Declaration => 519, + Iir_Kind_Group_Template_Declaration => 525, + Iir_Kind_Group_Declaration => 532, + Iir_Kind_Element_Declaration => 539, + Iir_Kind_Non_Object_Alias_Declaration => 547, + Iir_Kind_Psl_Declaration => 555, + Iir_Kind_Terminal_Declaration => 561, + Iir_Kind_Free_Quantity_Declaration => 570, + Iir_Kind_Across_Quantity_Declaration => 582, + Iir_Kind_Through_Quantity_Declaration => 594, + Iir_Kind_Enumeration_Literal => 605, + Iir_Kind_Function_Declaration => 629, + Iir_Kind_Procedure_Declaration => 651, + Iir_Kind_Function_Body => 661, + Iir_Kind_Procedure_Body => 671, + Iir_Kind_Object_Alias_Declaration => 683, + Iir_Kind_File_Declaration => 698, + Iir_Kind_Guard_Signal_Declaration => 711, + Iir_Kind_Signal_Declaration => 728, + Iir_Kind_Variable_Declaration => 741, + Iir_Kind_Constant_Declaration => 755, + Iir_Kind_Iterator_Declaration => 767, + Iir_Kind_Interface_Constant_Declaration => 783, + Iir_Kind_Interface_Variable_Declaration => 799, + Iir_Kind_Interface_Signal_Declaration => 820, + Iir_Kind_Interface_File_Declaration => 836, + Iir_Kind_Interface_Package_Declaration => 845, + Iir_Kind_Identity_Operator => 849, + Iir_Kind_Negation_Operator => 853, + Iir_Kind_Absolute_Operator => 857, + Iir_Kind_Not_Operator => 861, + Iir_Kind_Condition_Operator => 865, + Iir_Kind_Reduction_And_Operator => 869, + Iir_Kind_Reduction_Or_Operator => 873, + Iir_Kind_Reduction_Nand_Operator => 877, + Iir_Kind_Reduction_Nor_Operator => 881, + Iir_Kind_Reduction_Xor_Operator => 885, + Iir_Kind_Reduction_Xnor_Operator => 889, + Iir_Kind_And_Operator => 894, + Iir_Kind_Or_Operator => 899, + Iir_Kind_Nand_Operator => 904, + Iir_Kind_Nor_Operator => 909, + Iir_Kind_Xor_Operator => 914, + Iir_Kind_Xnor_Operator => 919, + Iir_Kind_Equality_Operator => 924, + Iir_Kind_Inequality_Operator => 929, + Iir_Kind_Less_Than_Operator => 934, + Iir_Kind_Less_Than_Or_Equal_Operator => 939, + Iir_Kind_Greater_Than_Operator => 944, + Iir_Kind_Greater_Than_Or_Equal_Operator => 949, + Iir_Kind_Match_Equality_Operator => 954, + Iir_Kind_Match_Inequality_Operator => 959, + Iir_Kind_Match_Less_Than_Operator => 964, + Iir_Kind_Match_Less_Than_Or_Equal_Operator => 969, + Iir_Kind_Match_Greater_Than_Operator => 974, + Iir_Kind_Match_Greater_Than_Or_Equal_Operator => 979, + Iir_Kind_Sll_Operator => 984, + Iir_Kind_Sla_Operator => 989, + Iir_Kind_Srl_Operator => 994, + Iir_Kind_Sra_Operator => 999, + Iir_Kind_Rol_Operator => 1004, + Iir_Kind_Ror_Operator => 1009, + Iir_Kind_Addition_Operator => 1014, + Iir_Kind_Substraction_Operator => 1019, + Iir_Kind_Concatenation_Operator => 1024, + Iir_Kind_Multiplication_Operator => 1029, + Iir_Kind_Division_Operator => 1034, + Iir_Kind_Modulus_Operator => 1039, + Iir_Kind_Remainder_Operator => 1044, + Iir_Kind_Exponentiation_Operator => 1049, + Iir_Kind_Function_Call => 1057, + Iir_Kind_Aggregate => 1063, + Iir_Kind_Parenthesis_Expression => 1066, + Iir_Kind_Qualified_Expression => 1070, + Iir_Kind_Type_Conversion => 1075, + Iir_Kind_Allocator_By_Expression => 1079, + Iir_Kind_Allocator_By_Subtype => 1083, + Iir_Kind_Selected_Element => 1089, + Iir_Kind_Dereference => 1094, + Iir_Kind_Implicit_Dereference => 1099, + Iir_Kind_Slice_Name => 1106, + Iir_Kind_Indexed_Name => 1112, + Iir_Kind_Psl_Expression => 1114, + Iir_Kind_Sensitized_Process_Statement => 1133, + Iir_Kind_Process_Statement => 1151, + Iir_Kind_Concurrent_Conditional_Signal_Assignment => 1162, + Iir_Kind_Concurrent_Selected_Signal_Assignment => 1174, + Iir_Kind_Concurrent_Assertion_Statement => 1182, + Iir_Kind_Psl_Default_Clock => 1186, + Iir_Kind_Psl_Assert_Statement => 1195, + Iir_Kind_Psl_Cover_Statement => 1204, + Iir_Kind_Concurrent_Procedure_Call_Statement => 1210, + Iir_Kind_Block_Statement => 1223, + Iir_Kind_Generate_Statement => 1235, + Iir_Kind_Component_Instantiation_Statement => 1245, + Iir_Kind_Simple_Simultaneous_Statement => 1252, + Iir_Kind_Signal_Assignment_Statement => 1261, + Iir_Kind_Null_Statement => 1265, + Iir_Kind_Assertion_Statement => 1272, + Iir_Kind_Report_Statement => 1278, + Iir_Kind_Wait_Statement => 1285, + Iir_Kind_Variable_Assignment_Statement => 1291, + Iir_Kind_Return_Statement => 1297, + Iir_Kind_For_Loop_Statement => 1305, + Iir_Kind_While_Loop_Statement => 1312, + Iir_Kind_Next_Statement => 1318, + Iir_Kind_Exit_Statement => 1324, + Iir_Kind_Case_Statement => 1331, + Iir_Kind_Procedure_Call_Statement => 1336, + Iir_Kind_If_Statement => 1344, + Iir_Kind_Elsif => 1349, + Iir_Kind_Character_Literal => 1356, + Iir_Kind_Simple_Name => 1363, + Iir_Kind_Selected_Name => 1371, + Iir_Kind_Operator_Symbol => 1376, + Iir_Kind_Selected_By_All_Name => 1381, + Iir_Kind_Parenthesis_Name => 1385, + Iir_Kind_Base_Attribute => 1387, + Iir_Kind_Left_Type_Attribute => 1392, + Iir_Kind_Right_Type_Attribute => 1397, + Iir_Kind_High_Type_Attribute => 1402, + Iir_Kind_Low_Type_Attribute => 1407, + Iir_Kind_Ascending_Type_Attribute => 1412, + Iir_Kind_Image_Attribute => 1418, + Iir_Kind_Value_Attribute => 1424, + Iir_Kind_Pos_Attribute => 1430, + Iir_Kind_Val_Attribute => 1436, + Iir_Kind_Succ_Attribute => 1442, + Iir_Kind_Pred_Attribute => 1448, + Iir_Kind_Leftof_Attribute => 1454, + Iir_Kind_Rightof_Attribute => 1460, + Iir_Kind_Delayed_Attribute => 1468, + Iir_Kind_Stable_Attribute => 1476, + Iir_Kind_Quiet_Attribute => 1484, + Iir_Kind_Transaction_Attribute => 1492, + Iir_Kind_Event_Attribute => 1496, + Iir_Kind_Active_Attribute => 1500, + Iir_Kind_Last_Event_Attribute => 1504, + Iir_Kind_Last_Active_Attribute => 1508, + Iir_Kind_Last_Value_Attribute => 1512, + Iir_Kind_Driving_Attribute => 1516, + Iir_Kind_Driving_Value_Attribute => 1520, + Iir_Kind_Behavior_Attribute => 1520, + Iir_Kind_Structure_Attribute => 1520, + Iir_Kind_Simple_Name_Attribute => 1527, + Iir_Kind_Instance_Name_Attribute => 1532, + Iir_Kind_Path_Name_Attribute => 1537, + Iir_Kind_Left_Array_Attribute => 1544, + Iir_Kind_Right_Array_Attribute => 1551, + Iir_Kind_High_Array_Attribute => 1558, + Iir_Kind_Low_Array_Attribute => 1565, + Iir_Kind_Length_Array_Attribute => 1572, + Iir_Kind_Ascending_Array_Attribute => 1579, + Iir_Kind_Range_Array_Attribute => 1586, + Iir_Kind_Reverse_Range_Array_Attribute => 1593, + Iir_Kind_Attribute_Name => 1601 ); function Get_Fields (K : Iir_Kind) return Fields_Array @@ -4062,6 +4080,12 @@ package body Nodes_Meta is begin pragma Assert (Fields_Type (F) = Type_Boolean); case F is + when Field_Has_Signed => + return Get_Has_Signed (N); + when Field_Has_Sign => + return Get_Has_Sign (N); + when Field_Has_Length => + return Get_Has_Length (N); when Field_Whole_Association_Flag => return Get_Whole_Association_Flag (N); when Field_Collapse_Signal_Flag => @@ -4158,6 +4182,12 @@ package body Nodes_Meta is begin pragma Assert (Fields_Type (F) = Type_Boolean); case F is + when Field_Has_Signed => + Set_Has_Signed (N, V); + when Field_Has_Sign => + Set_Has_Sign (N, V); + when Field_Has_Length => + Set_Has_Length (N, V); when Field_Whole_Association_Flag => Set_Whole_Association_Flag (N, V); when Field_Collapse_Signal_Flag => @@ -5924,6 +5954,21 @@ package body Nodes_Meta is return K = Iir_Kind_String_Literal8; end Has_Bit_String_Base; + function Has_Has_Signed (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_String_Literal8; + end Has_Has_Signed; + + function Has_Has_Sign (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_String_Literal8; + end Has_Has_Sign; + + function Has_Has_Length (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_String_Literal8; + end Has_Has_Length; + function Has_Literal_Origin (K : Iir_Kind) return Boolean is begin case K is diff --git a/src/vhdl/nodes_meta.ads b/src/vhdl/nodes_meta.ads index a120a76..a04a311 100644 --- a/src/vhdl/nodes_meta.ads +++ b/src/vhdl/nodes_meta.ads @@ -88,6 +88,9 @@ package Nodes_Meta is Field_Fp_Value, Field_Simple_Aggregate_List, Field_Bit_String_Base, + Field_Has_Signed, + Field_Has_Sign, + Field_Has_Length, Field_Literal_Origin, Field_Range_Origin, Field_Literal_Subtype, @@ -548,6 +551,9 @@ package Nodes_Meta is function Has_Fp_Value (K : Iir_Kind) return Boolean; function Has_Simple_Aggregate_List (K : Iir_Kind) return Boolean; function Has_Bit_String_Base (K : Iir_Kind) return Boolean; + function Has_Has_Signed (K : Iir_Kind) return Boolean; + function Has_Has_Sign (K : Iir_Kind) return Boolean; + function Has_Has_Length (K : Iir_Kind) return Boolean; function Has_Literal_Origin (K : Iir_Kind) return Boolean; function Has_Range_Origin (K : Iir_Kind) return Boolean; function Has_Literal_Subtype (K : Iir_Kind) return Boolean; diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb index dedcee1..0633cad 100644 --- a/src/vhdl/parse.adb +++ b/src/vhdl/parse.adb @@ -3943,6 +3943,176 @@ package body Parse is return Res; end Parse_Allocator; + -- precond : tok_bit_string + -- postcond: tok_bit_string + -- + -- Simply create the node for a bit string. + function Parse_Bit_String return Iir + is + Res : Iir; + C : Character; + B : Base_Type; + begin + Res := Create_Iir (Iir_Kind_String_Literal8); + Set_Location (Res); + Set_String8_Id (Res, Current_String_Id); + Set_String_Length (Res, Current_String_Length); + if Name_Table.Name_Buffer (1) = 's' then + Set_Has_Sign (Res, True); + Set_Has_Signed (Res, True); + pragma Assert (Name_Table.Name_Length = 2); + C := Name_Table.Name_Buffer (2); + elsif Name_Table.Name_Buffer (1) = 'u' then + Set_Has_Sign (Res, True); + Set_Has_Signed (Res, False); + pragma Assert (Name_Table.Name_Length = 2); + C := Name_Table.Name_Buffer (2); + else + Set_Has_Sign (Res, False); + Set_Has_Signed (Res, False); + pragma Assert (Name_Table.Name_Length = 1); + C := Name_Table.Name_Buffer (1); + end if; + + case C is + when 'b' => + B := Base_2; + when 'o' => + B := Base_8; + when 'd' => + B := Base_10; + when 'x' => + B := Base_16; + when others => + raise Internal_Error; + end case; + Set_Bit_String_Base (Res, B); + + return Res; + end Parse_Bit_String; + + -- Scan returns an expanded bit value. Adjust the expanded bit value as + -- required by the length. + procedure Resize_Bit_String (Lit : Iir; Nlen : Nat32) + is + use Str_Table; + + Old_Len : constant Nat32 := Get_String_Length (Lit); + Is_Signed : constant Boolean := Get_Has_Signed (Lit); + Id : constant String8_Id := Get_String8_Id (Lit); + C : Nat8; + begin + if Nlen > Old_Len then + -- Extend. + + -- LRM08 15.8 + -- -- If the length is greater than the number of characters in the + -- expanded bit value and the base specifier is B, UB, O, UO, X, + -- UX or D, the bit string value is obtained by concatenating a + -- string of 0 digits to the left of the expanded bit value. The + -- number of 0 digits in the string is such that the number of + -- characters in the result of the concatenation is the length of + -- the bit string literal. + -- + -- -- If the length is greater than the number of characters in the + -- expanded bit value and the base specifier is SB, SO or SX, the + -- bit string value is obtained by concatenating the the left of + -- the expanded bit value a string, each of whose characters is + -- the leftmost character of the expanded bit value. The number + -- of characters in the string is such that the number of + -- characters in the result of the concatenation is the length of + -- the bit string literal. + if Is_Signed then + if Old_Len = 0 then + Error_Msg_Parse + ("cannot expand an empty signed bit string", Lit); + C := Character'Pos ('0'); + else + C := Element_String8 (Id, 1); + end if; + else + C := Character'Pos ('0'); + end if; + Resize_String8 (Nlen); + -- Shift (position 1 is the MSB). + for I in reverse 1 .. Old_Len loop + Set_Element_String8 (Id, I + Nlen - Old_Len, + Element_String8 (Id, I)); + end loop; + for I in 1 .. Nlen - Old_Len loop + Set_Element_String8 (Id, I, C); + end loop; + Set_String_Length (Lit, Nlen); + + elsif Nlen < Old_Len then + -- Reduce. + + -- LRM08 15.8 + -- -- If the length is less than the number of characters in the + -- expanded bit value and the base specifier is B, UB, O, UO, X, + -- UX or D, the bit string value is obtained by deleting + -- sufficient characters from the left of the expanded bit value + -- to yield a string whose length is the length of the bit string + -- literal. It is an error if any of the character so deleted is + -- other than the digit 0. + -- + -- -- If the length is less than the number of characters in the + -- expanded bit value and the base specifier is SB, SO or SX, the + -- bit string value is obtained by deleting sufficient characters + -- from the left of the expanded bit value to yield a string whose + -- length is the length of the bit string literal. It is an error + -- if any of the characters so deleted differs from the leftmost + -- remaining character. + if Is_Signed then + C := Element_String8 (Id, 1 + Old_Len - Nlen); + else + C := Character'Pos ('0'); + end if; + for I in 1 .. Old_Len - Nlen loop + if Element_String8 (Id, I) /= C then + Error_Msg_Parse + ("truncation of bit string changes the value", Lit); + -- Avoid error storm. + exit; + end if; + end loop; + -- Shift (position 1 is the MSB). + for I in 1 .. Nlen loop + Set_Element_String8 (Id, I, + Element_String8 (Id, I + Old_Len - Nlen)); + end loop; + Resize_String8 (Nlen); + Set_String_Length (Lit, Nlen); + + else + -- LRM08 15.8 + -- -- If the length is equal to the number of characters in the + -- expanded bit value, the string literal value is the expanded + -- bit value itself. + null; + end if; + end Resize_Bit_String; + + -- Precond : next token after tok_integer + -- postcond: likewise + -- + -- Return an integer_literal or a physical_literal. + function Parse_Integer_Literal (Val : Iir_Int64) return Iir + is + Res : Iir; + begin + if Current_Token = Tok_Identifier then + -- physical literal + Res := Create_Iir (Iir_Kind_Physical_Int_Literal); + Set_Unit_Name (Res, Parse_Name (Allow_Indexes => False)); + else + -- integer literal + Res := Create_Iir (Iir_Kind_Integer_Literal); + end if; + Set_Value (Res, Val); + return Res; + end Parse_Integer_Literal; + -- precond : next token -- postcond: next token -- @@ -3987,16 +4157,8 @@ package body Parse is -- Skip integer Scan; - if Current_Token = Tok_Identifier then - -- physical literal - Res := Create_Iir (Iir_Kind_Physical_Int_Literal); - Set_Unit_Name (Res, Parse_Name (Allow_Indexes => False)); - else - -- integer literal - Res := Create_Iir (Iir_Kind_Integer_Literal); - end if; + Res := Parse_Integer_Literal (Int); Set_Location (Res, Loc); - Set_Value (Res, Int); return Res; when Tok_Real => @@ -4043,23 +4205,39 @@ package body Parse is return Res; when Tok_New => return Parse_Allocator; + + when Tok_Integer_Letter => + Int := Current_Iir_Int64; + Loc := Get_Token_Location; + + -- Skip integer + Scan; + + if Current_Token = Tok_Bit_String then + Res := Parse_Bit_String; + + -- Skip bit string + Scan; + + -- Resize. + Resize_Bit_String (Res, Nat32 (Int)); + else + Error_Msg_Parse + ("space is required between number and unit name", + Get_Token_Location); + Res := Parse_Integer_Literal (Int); + end if; + Set_Location (Res, Loc); + return Res; + when Tok_Bit_String => - Res := Create_Iir (Iir_Kind_String_Literal8); - Set_Location (Res); - Set_String8_Id (Res, Current_String_Id); - Set_String_Length (Res, Current_String_Length); - case Current_Iir_Int64 is - when 1 => - Set_Bit_String_Base (Res, Base_2); - when 3 => - Set_Bit_String_Base (Res, Base_8); - when 4 => - Set_Bit_String_Base (Res, Base_16); - when others => - raise Internal_Error; - end case; + Res := Parse_Bit_String; + + -- Skip bit string Scan; + return Res; + when Tok_Minus | Tok_Plus => Error_Msg_Parse diff --git a/src/vhdl/scanner.adb b/src/vhdl/scanner.adb index 632e240..02cd752 100644 --- a/src/vhdl/scanner.adb +++ b/src/vhdl/scanner.adb @@ -361,7 +361,7 @@ package body Scanner is begin -- String delimiter. Mark := Source (Pos); - pragma Assert (Mark = Quotation or else Mark = '%'); + pragma Assert (Mark = '"' or else Mark = '%'); Pos := Pos + 1; Length := 0; @@ -427,40 +427,25 @@ package body Scanner is -- -- The current character must be a base specifier, followed by '"' or '%'. -- The base must be valid. - procedure Scan_Bit_String + procedure Scan_Bit_String (Base_Log : Nat32) is - -- The base specifier. - Base_Log : Nat32 range 1 .. 4; + -- Position of character '0'. + Pos_0 : constant Nat8 := Character'Pos ('0'); + + -- Used for the base. + subtype Nat4 is Natural range 1 .. 4; + Base : constant Nat32 := 2 ** Nat4 (Base_Log); + -- The quotation character (can be " or %). - Mark: Character; + Mark : constant Character := Source (Pos); -- Current character. C : Character; -- Current length. Length : Nat32; -- Digit value. V, D : Nat8; - -- Position of character '0'. - Pos_0 : constant Nat8 := Character'Pos ('0'); begin - -- LRM93 13.7 - -- A letter in a bit string literal (... or the base specificer) can be - -- written either in lowercase or in upper case, with the same meaning. - -- - -- LRM08 15.8 Bit string literals - -- Not present! - case Source (Pos) is - when 'x' | 'X' => - Base_Log := 4; - when 'o' | 'O' => - Base_Log := 3; - when 'b' | 'B' => - Base_Log := 1; - when others => - raise Internal_Error; - end case; - Pos := Pos + 1; - Mark := Source (Pos); - pragma Assert (Mark = Quotation or else Mark = '%'); + pragma Assert (Mark = '"' or else Mark = '%'); Pos := Pos + 1; Length := 0; Current_Context.Str_Id := Str_Table.Create_String8; @@ -512,47 +497,212 @@ package body Scanner is ("'%' cannot close a bit string opened by '""'"); exit; when others => + if Characters_Kind (C) in Graphic_Character then + if Vhdl_Std >= Vhdl_08 then + V := Nat8'Last; + else + Error_Msg_Scan ("invalid character in bit string"); + -- Continue the bit string + V := 0; + end if; + else + Error_Msg_Scan ("bit string not terminated"); + Pos := Pos - 1; + exit; + end if; + end case; + + -- Expand bit value. + if Vhdl_Std >= Vhdl_08 and V > Base then + -- Expand as graphic character. + for I in 1 .. Base_Log loop + Str_Table.Append_String8_Char (C); + end loop; + else + -- Expand as extended digits. + case Base_Log is + when 1 => + if V > 1 then + Error_Msg_Scan + ("invalid character in a binary bit string"); + V := 1; + end if; + Str_Table.Append_String8 (Pos_0 + V); + when 3 => + if V > 7 then + Error_Msg_Scan + ("invalid character in a octal bit string"); + V := 7; + end if; + for I in 1 .. 3 loop + D := V / 4; + Str_Table.Append_String8 (Pos_0 + D); + V := (V - 4 * D) * 2; + end loop; + when 4 => + for I in 1 .. 4 loop + D := V / 8; + Str_Table.Append_String8 (Pos_0 + D); + V := (V - 8 * D) * 2; + end loop; + when others => + raise Internal_Error; + end case; + end if; + + Length := Length + Base_Log; + end loop; + + if Length = 0 then + Error_Msg_Scan ("empty bit string is not allowed"); + end if; + Current_Token := Tok_Bit_String; + Current_Context.Str_Len := Length; + end Scan_Bit_String; + + procedure Scan_Dec_Bit_String + is + use Str_Table; + + Id : String8_Id; + + -- Position of character '0'. + Pos_0 : constant Nat8 := Character'Pos ('0'); + + -- Current character. + C : Character; + -- Current length. + Length : Nat32; + -- Digit value. + V, D : Nat8; + + type Carries_Type is array (0 .. 3) of Nat8; + Carries : Carries_Type; + No_Carries : constant Carries_Type := (others => Pos_0); + + -- Shift right carries. Note the Carries (0) is the LSB. + procedure Shr_Carries is + begin + Carries := (Carries (1), Carries (2), Carries (3), Pos_0); + end Shr_Carries; + + procedure Append_Carries is + begin + -- Expand the bit string. Note that position 1 of the string8 is + -- the MSB. + while Carries /= No_Carries loop + Append_String8 (Pos_0); + Length := Length + 1; + for I in reverse 2 .. Length loop + Set_Element_String8 (Id, I, Element_String8 (Id, I - 1)); + end loop; + Set_Element_String8 (Id, 1, Carries (0)); + Shr_Carries; + end loop; + end Append_Carries; + + procedure Add_One_To_Carries is + begin + for I in Carries'Range loop + if Carries (I) = Pos_0 then + Carries (I) := Pos_0 + 1; + -- End of propagation. + exit; + else + Carries (I) := Pos_0; + -- Continue propagation. + end if; + end loop; + end Add_One_To_Carries; + begin + pragma Assert (Source (Pos) = '"'); + Pos := Pos + 1; + Length := 0; + Id := Create_String8; + Current_Context.Str_Id := Id; + loop + << Again >> null; + C := Source (Pos); + Pos := Pos + 1; + exit when C = '"'; + + if C in '0' .. '9' then + V := Character'Pos (C) - Character'Pos ('0'); + elsif C = '_' then + if Source (Pos) = '_' then + Error_Msg_Scan + ("double underscore not allowed in a bit string"); + end if; + if Source (Pos - 2) = '"' then + Error_Msg_Scan + ("underscore not allowed at the start of a bit string"); + elsif Source (Pos) = '"' then + Error_Msg_Scan + ("underscore not allowed at the end of a bit string"); + end if; + goto Again; + else + if Characters_Kind (C) in Graphic_Character then + Error_Msg_Scan + ("graphic character not allowed in decimal bit string"); + -- Continue the bit string + V := 0; + else Error_Msg_Scan ("bit string not terminated"); Pos := Pos - 1; exit; - end case; + end if; + end if; - case Base_Log is - when 1 => - if V > 1 then - Error_Msg_Scan ("invalid character in a binary bit string"); - V := 1; - end if; - Str_Table.Append_String8 (Pos_0 + V); - when 2 => - raise Internal_Error; - when 3 => - if V > 7 then - Error_Msg_Scan ("invalid character in a octal bit string"); - V := 7; - end if; - for I in 1 .. 3 loop - D := V / 4; - Str_Table.Append_String8 (Pos_0 + D); - V := (V - 4 * D) * 2; - end loop; - when 4 => - for I in 1 .. 4 loop - D := V / 8; - Str_Table.Append_String8 (Pos_0 + D); - V := (V - 8 * D) * 2; + -- Multiply by 10. + Carries := (others => Pos_0); + for I in reverse 1 .. Length loop + -- Shift by 1 (*2). + D := Element_String8 (Id, I); + Set_Element_String8 (Id, I, Carries (0)); + Shr_Carries; + -- Add D and D * 4. + if D /= Pos_0 then + Add_One_To_Carries; + -- Add_Four_To_Carries: + for I in 2 .. 3 loop + if Carries (I) = Pos_0 then + Carries (I) := Pos_0 + 1; + -- End of propagation. + exit; + else + Carries (I) := Pos_0; + -- Continue propagation. + end if; end loop; - end case; - Length := Length + Base_Log; + end if; + end loop; + Append_Carries; + + -- Add V. + for I in Carries'Range loop + D := V / 2; + Carries (I) := Pos_0 + (V - 2 * D); + V := D; + end loop; + for I in reverse 1 .. Length loop + D := Element_String8 (Id, I); + if D /= Pos_0 then + Add_One_To_Carries; + end if; + Set_Element_String8 (Id, I, Carries (0)); + Shr_Carries; + exit when Carries = No_Carries; + end loop; + Append_Carries; end loop; if Length = 0 then Error_Msg_Scan ("empty bit string is not allowed"); end if; Current_Token := Tok_Bit_String; - Current_Context.Int64 := Iir_Int64 (Base_Log); Current_Context.Str_Len := Length; - end Scan_Bit_String; + end Scan_Dec_Bit_String; -- LRM93 13.3.1 -- Basic Identifiers @@ -632,6 +782,7 @@ package body Scanner is Len := Len - 1; C := '_'; end if; + Name_Length := Len; -- LRM93 13.2 -- At least one separator is required between an identifier or an @@ -641,17 +792,63 @@ package body Scanner is | Upper_Case_Letter | Lower_Case_Letter => raise Internal_Error; - when Other_Special_Character => - if Vhdl_Std /= Vhdl_87 and then C = '\' then + when Other_Special_Character | Special_Character => + if (C = '"' or C = '%') and then Len <= 2 then + -- Good candidate for bit string. + + -- LRM93 13.7 + -- BASE_SPECIFIER ::= B | O | X + -- + -- A letter in a bit string literal (either an extended digit + -- or the base specifier) can be written either in lower case + -- or in upper case, with the same meaning. + -- + -- LRM08 15.8 Bit string literals + -- BASE_SPECICIER ::= + -- B | O | X | UB | UO | UX | SB | SO | SX | D + -- + -- An extended digit and the base specifier in a bit string + -- literal can be written either in lowercase or in uppercase, + -- with the same meaning. + declare + Base : Nat32; + Cl : constant Character := Name_Buffer (Len); + Cf : constant Character := Name_Buffer (1); + begin + if Cl = 'b' then + Base := 1; + elsif Cl = 'o' then + Base := 3; + elsif Cl = 'x' then + Base := 4; + elsif Vhdl_Std >= Vhdl_08 and Len = 1 and Cf = 'd' then + Scan_Dec_Bit_String; + return; + else + Base := 0; + end if; + if Base > 0 then + if Len = 1 then + Scan_Bit_String (Base); + return; + elsif Vhdl_Std >= Vhdl_08 + and then (Cf = 's' or Cf = 'u') + then + Scan_Bit_String (Base); + return; + end if; + end if; + end; + end if; + if Vhdl_Std > Vhdl_87 and then C = '\' then + -- Start of extended identifier. Cannot follow an identifier. Error_Separator; end if; when Invalid | Format_Effector - | Space_Character - | Special_Character => + | Space_Character => null; end case; - Name_Length := Len; -- Hash it. Current_Context.Identifier := Name_Table.Get_Identifier; @@ -1379,7 +1576,7 @@ package body Scanner is when '0' .. '9' => Scan_Literal; - -- LRM 13.2 + -- LRM93 13.2 -- At least one separator is required between an identifier or -- an abstract literal and an adjacent identifier or abstract -- literal. @@ -1390,13 +1587,19 @@ package body Scanner is | Lower_Case_Letter => -- Could call Error_Separator, but use a clearer message -- for this common case. - -- Note: the term "unit name" is not correct here, since it - -- can be any identifier or even a keyword; however it is - -- probably the most common case (eg 10ns). - Error_Msg_Scan - ("space is required between number and unit name"); + -- Note: the term "unit name" is not correct here, since + -- it can be any identifier or even a keyword; however it + -- is probably the most common case (eg 10ns). + if Vhdl_Std >= Vhdl_08 and then Current_Token = Tok_Integer + then + Current_Token := Tok_Integer_Letter; + else + Error_Msg_Scan + ("space is required between number and unit name"); + end if; when Other_Special_Character => - if Vhdl_Std /= Vhdl_87 and then Source (Pos) = '\' then + if Vhdl_Std > Vhdl_87 and then Source (Pos) = '\' then + -- Start of extended identifier. Error_Separator; end if; when Invalid @@ -1555,20 +1758,7 @@ package body Scanner is Error_Msg_Scan ("an identifier can't start with '_'"); Pos := Pos + 1; goto Again; - when 'B' | 'b' | 'O' | 'o' | 'X' | 'x' => - if Source (Pos + 1) = Quotation or else Source (Pos + 1) = '%' then - -- LRM93 13.7 - -- BASE_SPECIFIER ::= B | O | X - -- A letter in a bit string literal (either an extended digit or - -- the base specifier) can be written either in lower case or - -- in upper case, with the same meaning. - Scan_Bit_String; - else - Scan_Identifier; - end if; - return; - when 'A' | 'C' .. 'N' | 'P' .. 'W' | 'Y'| 'Z' - | 'a' | 'c' .. 'n' | 'p' .. 'w' | 'y'| 'z' => + when 'A' .. 'Z' | 'a' .. 'z' => Scan_Identifier; return; when UC_A_Grave .. UC_O_Diaeresis diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb index 16add4f..af59a3a 100644 --- a/src/vhdl/sem_expr.adb +++ b/src/vhdl/sem_expr.adb @@ -1897,6 +1897,12 @@ package body Sem_Expr is end if; Inter := Get_Next_Interpretation (Inter); end loop; + + -- LRM08 9.3 Operands + -- The character literals corresponding to the graphic characters + -- contained within a string literal or a bit string literal shall + -- be visible at the place of the string literal. + -- Character C is not visible... if Find_Name_In_List (Get_Enumeration_Literal_List (Etype), Id) = Null_Iir @@ -1919,55 +1925,31 @@ package body Sem_Expr is El : Iir; Enum_Pos : Iir_Int32; Ch : Character; - begin - if Get_Bit_String_Base (Str) /= Base_None then - -- A bit string. - declare - Map : Characters_Pos ('0' .. '1'); - begin - for C in Character range '0' .. '1' loop - El := Find_Literal (El_Type, C); - if El = Null_Iir then - Enum_Pos := 0; - else - Enum_Pos := Get_Enum_Pos (El); - end if; - Map (C) := Nat8 (Enum_Pos); - end loop; - for I in 1 .. Len loop - Ch := Str_Table.Char_String8 (Id, I); - pragma Assert (Ch in Map'Range); - Str_Table.Set_Element_String8 (Id, I, Map (Ch)); - end loop; - end; - else - -- A string. - declare - -- Create a cache of literals, to speed-up a little bit the - -- search. - No_Pos : constant Nat8 := Nat8'Last; - Map : Characters_Pos (' ' .. Character'Last) := (others => No_Pos); - Res : Nat8; - begin - for I in 1 .. Len loop - Ch := Str_Table.Char_String8 (Id, I); - Res := Map (Ch); - if Res = No_Pos then - El := Find_Literal (El_Type, Ch); - if El = Null_Iir then - Res := 0; - else - Enum_Pos := Get_Enum_Pos (El); - Res := Nat8 (Enum_Pos); - Map (Ch) := Res; - end if; - end if; - Str_Table.Set_Element_String8 (Id, I, Res); - end loop; - end; - end if; + -- Create a cache of literals, to speed-up a little bit the + -- search. + No_Pos : constant Nat8 := Nat8'Last; + Map : Characters_Pos (' ' .. Character'Last) := (others => No_Pos); + Res : Nat8; + begin + for I in 1 .. Len loop + Ch := Str_Table.Char_String8 (Id, I); + Res := Map (Ch); + if Res = No_Pos then + El := Find_Literal (El_Type, Ch); + if El = Null_Iir then + Res := 0; + else + Enum_Pos := Get_Enum_Pos (El); + Res := Nat8 (Enum_Pos); + Map (Ch) := Res; + end if; + end if; + Str_Table.Set_Element_String8 (Id, I, Res); + end loop; + -- LRM08 9.4.2 Locally static primaries + -- a) A literal of any type other than type TIME Set_Expr_Staticness (Str, Locally); return Natural (Len); diff --git a/src/vhdl/tokens.adb b/src/vhdl/tokens.adb index f741127..904bd7d 100644 --- a/src/vhdl/tokens.adb +++ b/src/vhdl/tokens.adb @@ -61,7 +61,8 @@ package body Tokens is return "<character>"; when Tok_Identifier => return "<identifier>"; - when Tok_Integer => + when Tok_Integer + | Tok_Integer_Letter => return "<integer>"; when Tok_Real => return "<real>"; diff --git a/src/vhdl/tokens.ads b/src/vhdl/tokens.ads index bd313e2..adbccb2 100644 --- a/src/vhdl/tokens.ads +++ b/src/vhdl/tokens.ads @@ -47,8 +47,17 @@ package Tokens is Tok_Integer, Tok_Real, Tok_String, + + -- This token corresponds to a base specifier followed by bit_value. + -- The base specifier is stored in Name_Buffer/Name_Length like an + -- identifier (in lowercase), the String8_Id contains the expanded bit + -- value. Tok_Bit_String, + -- An integer immediately followed by a letter. This is used by to + -- scan vhdl 2008 (and later) bit string with a length. + Tok_Integer_Letter, + -- relational_operator Tok_Equal, -- = Tok_Not_Equal, -- /= |