diff options
author | Tristan Gingold | 2015-05-23 08:01:30 +0200 |
---|---|---|
committer | Tristan Gingold | 2015-05-23 08:01:30 +0200 |
commit | b8a48a6144a988904867fb044fbe2cb9f7d2750a (patch) | |
tree | 1ad4dd9eb9d685e4d86e734291bdcda94b68f7a6 | |
parent | 6d809ee2e64d5033b62db219f86707e30babe381 (diff) | |
download | ghdl-b8a48a6144a988904867fb044fbe2cb9f7d2750a.tar.gz ghdl-b8a48a6144a988904867fb044fbe2cb9f7d2750a.tar.bz2 ghdl-b8a48a6144a988904867fb044fbe2cb9f7d2750a.zip |
Preliminary work to support external names (parse, semantic)
-rw-r--r-- | src/vhdl/errorout.adb | 16 | ||||
-rw-r--r-- | src/vhdl/iirs.adb | 55 | ||||
-rw-r--r-- | src/vhdl/iirs.ads | 124 | ||||
-rw-r--r-- | src/vhdl/nodes_meta.adb | 242 | ||||
-rw-r--r-- | src/vhdl/nodes_meta.ads | 6 | ||||
-rw-r--r-- | src/vhdl/parse.adb | 233 | ||||
-rw-r--r-- | src/vhdl/scanner.adb | 54 | ||||
-rw-r--r-- | src/vhdl/sem_expr.adb | 8 | ||||
-rw-r--r-- | src/vhdl/sem_names.adb | 19 | ||||
-rw-r--r-- | src/vhdl/sem_names.ads | 3 | ||||
-rw-r--r-- | src/vhdl/tokens.adb | 7 | ||||
-rw-r--r-- | src/vhdl/tokens.ads | 4 |
12 files changed, 659 insertions, 112 deletions
diff --git a/src/vhdl/errorout.adb b/src/vhdl/errorout.adb index 7928b74..442aeb0 100644 --- a/src/vhdl/errorout.adb +++ b/src/vhdl/errorout.adb @@ -479,6 +479,22 @@ package body Errorout is return ''' & Name_Table.Nam_Buffer (1 .. Name_Table.Nam_Length) & '''; + when Iir_Kind_External_Constant_Name => + return "external constant name"; + when Iir_Kind_External_Signal_Name => + return "external signal name"; + when Iir_Kind_External_Variable_Name => + return "external variable name"; + + when Iir_Kind_Package_Pathname => + return "package pathname"; + when Iir_Kind_Absolute_Pathname => + return "absolute pathname"; + when Iir_Kind_Relative_Pathname => + return "relative pathname"; + when Iir_Kind_Pathname_Element => + return "pathname element"; + when Iir_Kind_Entity_Aspect_Entity => return "aspect " & Disp_Node (Get_Entity (Node)) & '(' & Image_Identifier (Get_Architecture (Node)) & ')'; diff --git a/src/vhdl/iirs.adb b/src/vhdl/iirs.adb index cb174ce..609d9fd 100644 --- a/src/vhdl/iirs.adb +++ b/src/vhdl/iirs.adb @@ -406,6 +406,13 @@ package body Iirs is | Iir_Kind_Operator_Symbol | Iir_Kind_Selected_By_All_Name | Iir_Kind_Parenthesis_Name + | Iir_Kind_External_Constant_Name + | Iir_Kind_External_Signal_Name + | Iir_Kind_External_Variable_Name + | Iir_Kind_Package_Pathname + | Iir_Kind_Absolute_Pathname + | Iir_Kind_Relative_Pathname + | Iir_Kind_Pathname_Element | Iir_Kind_Base_Attribute | Iir_Kind_Left_Type_Attribute | Iir_Kind_Right_Type_Attribute @@ -4195,6 +4202,54 @@ package body Iirs is Set_Field1 (Sign, Prefix); end Set_Signature_Prefix; + function Get_External_Pathname (Name : Iir) return Iir is + begin + pragma Assert (Name /= Null_Iir); + pragma Assert (Has_External_Pathname (Get_Kind (Name)), + "no field External_Pathname"); + return Get_Field3 (Name); + end Get_External_Pathname; + + procedure Set_External_Pathname (Name : Iir; Path : Iir) is + begin + pragma Assert (Name /= Null_Iir); + pragma Assert (Has_External_Pathname (Get_Kind (Name)), + "no field External_Pathname"); + Set_Field3 (Name, Path); + end Set_External_Pathname; + + function Get_Pathname_Suffix (Path : Iir) return Iir is + begin + pragma Assert (Path /= Null_Iir); + pragma Assert (Has_Pathname_Suffix (Get_Kind (Path)), + "no field Pathname_Suffix"); + return Get_Field2 (Path); + end Get_Pathname_Suffix; + + procedure Set_Pathname_Suffix (Path : Iir; Suffix : Iir) is + begin + pragma Assert (Path /= Null_Iir); + pragma Assert (Has_Pathname_Suffix (Get_Kind (Path)), + "no field Pathname_Suffix"); + Set_Field2 (Path, Suffix); + end Set_Pathname_Suffix; + + function Get_Pathname_Expression (Path : Iir) return Iir is + begin + pragma Assert (Path /= Null_Iir); + pragma Assert (Has_Pathname_Expression (Get_Kind (Path)), + "no field Pathname_Expression"); + return Get_Field5 (Path); + end Get_Pathname_Expression; + + procedure Set_Pathname_Expression (Path : Iir; Expr : Iir) is + begin + pragma Assert (Path /= Null_Iir); + pragma Assert (Has_Pathname_Expression (Get_Kind (Path)), + "no field Pathname_Expression"); + Set_Field5 (Path, Expr); + end Set_Pathname_Expression; + function Get_Slice_Subtype (Slice : Iir) return Iir is begin pragma Assert (Slice /= Null_Iir); diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads index 922ab47..e8a1b74 100644 --- a/src/vhdl/iirs.ads +++ b/src/vhdl/iirs.ads @@ -3253,6 +3253,59 @@ package Iirs is -- -- Get/Set_Name_Staticness (State2) + -- Iir_Kind_External_Constant_Name (Short) + -- Iir_Kind_External_Signal_Name (Short) + -- Iir_Kind_External_Variable_Name (Short) + -- + -- Get/Set_Parent (Field0) + -- + -- Get/Set_Type (Field1) + -- + -- Get/Set_Chain (Field2) + -- + -- Get/Set_External_Pathname (Field3) + -- + -- Get/Set_Subtype_Indication (Field5) + -- + -- Only for Iir_Kind_External_Variable_Name: + -- Get/Set_Shared_Flag (Flag2) + -- + -- Get/Set_Is_Ref (Flag7) + -- + -- Get/Set_Expr_Staticness (State1) + -- + -- Get/Set_Name_Staticness (State2) + + -- Iir_Kind_Package_Pathname (Short) + -- This node represents only the library_logical_name. Package and object + -- simple_names are represented by Selected_Name. + -- + -- Get/Set_Pathname_Suffix (Field2) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Named_Entity (Field4) + + -- Iir_Kind_Absolute_Pathname (Short) + -- Represents only the '.'. + -- + -- Get/Set_Pathname_Suffix (Field2) + + -- Iir_Kind_Relative_Pathname (Short) + -- Represents only one '^.' + -- + -- Get/Set_Pathname_Suffix (Field2) + + -- Iir_Kind_Pathname_Element (Short) + -- + -- Get/Set_Pathname_Suffix (Field2) + -- + -- Get/Set_Identifier (Field3) + -- + -- Get/Set_Named_Entity (Field4) + -- + -- Get/Set_Pathname_Expression (Field5) + ----------------- -- Attributes -- ----------------- @@ -3678,6 +3731,15 @@ package Iirs is Iir_Kind_Selected_By_All_Name, Iir_Kind_Parenthesis_Name, + Iir_Kind_External_Constant_Name, + Iir_Kind_External_Signal_Name, + Iir_Kind_External_Variable_Name, + + Iir_Kind_Package_Pathname, + Iir_Kind_Absolute_Pathname, + Iir_Kind_Relative_Pathname, + Iir_Kind_Pathname_Element, + -- Attributes Iir_Kind_Base_Attribute, Iir_Kind_Left_Type_Attribute, -- type_attribute @@ -4415,6 +4477,11 @@ package Iirs is Iir_Kind_Dereference .. Iir_Kind_Implicit_Dereference; + subtype Iir_Kinds_External_Name is Iir_Kind range + Iir_Kind_External_Constant_Name .. + --Iir_Kind_External_Signal_Name + Iir_Kind_External_Variable_Name; + -- Any attribute that is an expression. subtype Iir_Kinds_Expression_Attribute is Iir_Kind range Iir_Kind_Left_Type_Attribute .. @@ -4552,50 +4619,6 @@ package Iirs is --Iir_Kind_Disconnection_Specification Iir_Kind_Configuration_Specification; - subtype Iir_Kinds_Declaration is Iir_Kind range - Iir_Kind_Type_Declaration .. - --Iir_Kind_Anonymous_Type_Declaration - --Iir_Kind_Subtype_Declaration - --Iir_Kind_Nature_Declaration - --Iir_Kind_Subnature_Declaration - --Iir_Kind_Package_Declaration - --Iir_Kind_Package_Instantiation_Declaration - --Iir_Kind_Package_Body - --Iir_Kind_Configuration_Declaration - --Iir_Kind_Entity_Declaration - --Iir_Kind_Architecture_Body - --Iir_Kind_Context_Declaration - --Iir_Kind_Package_Header - --Iir_Kind_Unit_Declaration - --Iir_Kind_Library_Declaration - --Iir_Kind_Component_Declaration - --Iir_Kind_Attribute_Declaration - --Iir_Kind_Group_Template_Declaration - --Iir_Kind_Group_Declaration - --Iir_Kind_Element_Declaration - --Iir_Kind_Non_Object_Alias_Declaration - --Iir_Kind_Psl_Declaration - --Iir_Kind_Terminal_Declaration - --Iir_Kind_Free_Quantity_Declaration - --Iir_Kind_Across_Quantity_Declaration - --Iir_Kind_Through_Quantity_Declaration - --Iir_Kind_Enumeration_Literal - --Iir_Kind_Function_Declaration - --Iir_Kind_Procedure_Declaration - --Iir_Kind_Function_Body - --Iir_Kind_Procedure_Body - --Iir_Kind_Object_Alias_Declaration - --Iir_Kind_File_Declaration - --Iir_Kind_Guard_Signal_Declaration - --Iir_Kind_Signal_Declaration - --Iir_Kind_Variable_Declaration - --Iir_Kind_Constant_Declaration - --Iir_Kind_Iterator_Declaration - --Iir_Kind_Interface_Constant_Declaration - --Iir_Kind_Interface_Variable_Declaration - --Iir_Kind_Interface_Signal_Declaration - Iir_Kind_Interface_File_Declaration; - ------------------------------------- -- Types and subtypes declarations -- ------------------------------------- @@ -6173,6 +6196,19 @@ package Iirs is function Get_Signature_Prefix (Sign : Iir) return Iir; procedure Set_Signature_Prefix (Sign : Iir; Prefix : Iir); + -- External pathname for an external name. + -- Field: Field3 + function Get_External_Pathname (Name : Iir) return Iir; + procedure Set_External_Pathname (Name : Iir; Path : Iir); + + -- Field: Field2 + function Get_Pathname_Suffix (Path : Iir) return Iir; + procedure Set_Pathname_Suffix (Path : Iir; Suffix : Iir); + + -- Field: Field5 + function Get_Pathname_Expression (Path : Iir) return Iir; + procedure Set_Pathname_Expression (Path : Iir; Expr : Iir); + -- The subtype of a slice. Contrary to the Type field, this is not a -- reference. -- Field: Field3 diff --git a/src/vhdl/nodes_meta.adb b/src/vhdl/nodes_meta.adb index 8e380ae..cbe86fb 100644 --- a/src/vhdl/nodes_meta.adb +++ b/src/vhdl/nodes_meta.adb @@ -249,6 +249,9 @@ package body Nodes_Meta is Field_Name_Staticness => Type_Iir_Staticness, Field_Prefix => Type_Iir, Field_Signature_Prefix => Type_Iir, + Field_External_Pathname => Type_Iir, + Field_Pathname_Suffix => Type_Iir, + Field_Pathname_Expression => Type_Iir, Field_Slice_Subtype => Type_Iir, Field_Suffix => Type_Iir, Field_Index_Subtype => Type_Iir, @@ -782,6 +785,12 @@ package body Nodes_Meta is return "prefix"; when Field_Signature_Prefix => return "signature_prefix"; + when Field_External_Pathname => + return "external_pathname"; + when Field_Pathname_Suffix => + return "pathname_suffix"; + when Field_Pathname_Expression => + return "pathname_expression"; when Field_Slice_Subtype => return "slice_subtype"; when Field_Suffix => @@ -1320,6 +1329,20 @@ package body Nodes_Meta is return "selected_by_all_name"; when Iir_Kind_Parenthesis_Name => return "parenthesis_name"; + when Iir_Kind_External_Constant_Name => + return "external_constant_name"; + when Iir_Kind_External_Signal_Name => + return "external_signal_name"; + when Iir_Kind_External_Variable_Name => + return "external_variable_name"; + when Iir_Kind_Package_Pathname => + return "package_pathname"; + when Iir_Kind_Absolute_Pathname => + return "absolute_pathname"; + when Iir_Kind_Relative_Pathname => + return "relative_pathname"; + when Iir_Kind_Pathname_Element => + return "pathname_element"; when Iir_Kind_Base_Attribute => return "base_attribute"; when Iir_Kind_Left_Type_Attribute => @@ -1864,6 +1887,12 @@ package body Nodes_Meta is return Attr_None; when Field_Signature_Prefix => return Attr_Ref; + when Field_External_Pathname => + return Attr_None; + when Field_Pathname_Suffix => + return Attr_None; + when Field_Pathname_Expression => + return Attr_None; when Field_Slice_Subtype => return Attr_None; when Field_Suffix => @@ -3620,6 +3649,50 @@ package body Nodes_Meta is Field_Association_Chain, Field_Type, Field_Named_Entity, + -- Iir_Kind_External_Constant_Name + Field_Shared_Flag, + Field_Is_Ref, + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Chain, + Field_External_Pathname, + Field_Subtype_Indication, + Field_Parent, + Field_Type, + -- Iir_Kind_External_Signal_Name + Field_Shared_Flag, + Field_Is_Ref, + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Chain, + Field_External_Pathname, + Field_Subtype_Indication, + Field_Parent, + Field_Type, + -- Iir_Kind_External_Variable_Name + Field_Shared_Flag, + Field_Is_Ref, + Field_Expr_Staticness, + Field_Name_Staticness, + Field_Chain, + Field_External_Pathname, + Field_Subtype_Indication, + Field_Parent, + Field_Type, + -- Iir_Kind_Package_Pathname + Field_Identifier, + Field_Pathname_Suffix, + Field_Named_Entity, + Field_Base_Name, + -- Iir_Kind_Absolute_Pathname + Field_Pathname_Suffix, + -- Iir_Kind_Relative_Pathname + Field_Pathname_Suffix, + -- Iir_Kind_Pathname_Element + Field_Identifier, + Field_Pathname_Suffix, + Field_Pathname_Expression, + Field_Named_Entity, -- Iir_Kind_Base_Attribute Field_Prefix, Field_Type, @@ -4082,45 +4155,52 @@ package body Nodes_Meta is Iir_Kind_Operator_Symbol => 1412, Iir_Kind_Selected_By_All_Name => 1417, Iir_Kind_Parenthesis_Name => 1421, - Iir_Kind_Base_Attribute => 1423, - Iir_Kind_Left_Type_Attribute => 1428, - Iir_Kind_Right_Type_Attribute => 1433, - Iir_Kind_High_Type_Attribute => 1438, - Iir_Kind_Low_Type_Attribute => 1443, - Iir_Kind_Ascending_Type_Attribute => 1448, - Iir_Kind_Image_Attribute => 1454, - Iir_Kind_Value_Attribute => 1460, - Iir_Kind_Pos_Attribute => 1466, - Iir_Kind_Val_Attribute => 1472, - Iir_Kind_Succ_Attribute => 1478, - Iir_Kind_Pred_Attribute => 1484, - Iir_Kind_Leftof_Attribute => 1490, - Iir_Kind_Rightof_Attribute => 1496, - Iir_Kind_Delayed_Attribute => 1504, - Iir_Kind_Stable_Attribute => 1512, - Iir_Kind_Quiet_Attribute => 1520, - Iir_Kind_Transaction_Attribute => 1528, - Iir_Kind_Event_Attribute => 1532, - Iir_Kind_Active_Attribute => 1536, - Iir_Kind_Last_Event_Attribute => 1540, - Iir_Kind_Last_Active_Attribute => 1544, - Iir_Kind_Last_Value_Attribute => 1548, - Iir_Kind_Driving_Attribute => 1552, - Iir_Kind_Driving_Value_Attribute => 1556, - Iir_Kind_Behavior_Attribute => 1556, - Iir_Kind_Structure_Attribute => 1556, - Iir_Kind_Simple_Name_Attribute => 1563, - Iir_Kind_Instance_Name_Attribute => 1568, - Iir_Kind_Path_Name_Attribute => 1573, - Iir_Kind_Left_Array_Attribute => 1580, - Iir_Kind_Right_Array_Attribute => 1587, - Iir_Kind_High_Array_Attribute => 1594, - Iir_Kind_Low_Array_Attribute => 1601, - Iir_Kind_Length_Array_Attribute => 1608, - Iir_Kind_Ascending_Array_Attribute => 1615, - Iir_Kind_Range_Array_Attribute => 1622, - Iir_Kind_Reverse_Range_Array_Attribute => 1629, - Iir_Kind_Attribute_Name => 1637 + Iir_Kind_External_Constant_Name => 1430, + Iir_Kind_External_Signal_Name => 1439, + Iir_Kind_External_Variable_Name => 1448, + Iir_Kind_Package_Pathname => 1452, + Iir_Kind_Absolute_Pathname => 1453, + Iir_Kind_Relative_Pathname => 1454, + Iir_Kind_Pathname_Element => 1458, + Iir_Kind_Base_Attribute => 1460, + Iir_Kind_Left_Type_Attribute => 1465, + Iir_Kind_Right_Type_Attribute => 1470, + Iir_Kind_High_Type_Attribute => 1475, + Iir_Kind_Low_Type_Attribute => 1480, + Iir_Kind_Ascending_Type_Attribute => 1485, + Iir_Kind_Image_Attribute => 1491, + Iir_Kind_Value_Attribute => 1497, + Iir_Kind_Pos_Attribute => 1503, + Iir_Kind_Val_Attribute => 1509, + Iir_Kind_Succ_Attribute => 1515, + Iir_Kind_Pred_Attribute => 1521, + Iir_Kind_Leftof_Attribute => 1527, + Iir_Kind_Rightof_Attribute => 1533, + Iir_Kind_Delayed_Attribute => 1541, + Iir_Kind_Stable_Attribute => 1549, + Iir_Kind_Quiet_Attribute => 1557, + Iir_Kind_Transaction_Attribute => 1565, + Iir_Kind_Event_Attribute => 1569, + Iir_Kind_Active_Attribute => 1573, + Iir_Kind_Last_Event_Attribute => 1577, + Iir_Kind_Last_Active_Attribute => 1581, + Iir_Kind_Last_Value_Attribute => 1585, + Iir_Kind_Driving_Attribute => 1589, + Iir_Kind_Driving_Value_Attribute => 1593, + Iir_Kind_Behavior_Attribute => 1593, + Iir_Kind_Structure_Attribute => 1593, + Iir_Kind_Simple_Name_Attribute => 1600, + Iir_Kind_Instance_Name_Attribute => 1605, + Iir_Kind_Path_Name_Attribute => 1610, + Iir_Kind_Left_Array_Attribute => 1617, + Iir_Kind_Right_Array_Attribute => 1624, + Iir_Kind_High_Array_Attribute => 1631, + Iir_Kind_Low_Array_Attribute => 1638, + Iir_Kind_Length_Array_Attribute => 1645, + Iir_Kind_Ascending_Array_Attribute => 1652, + Iir_Kind_Range_Array_Attribute => 1659, + Iir_Kind_Reverse_Range_Array_Attribute => 1666, + Iir_Kind_Attribute_Name => 1674 ); function Get_Fields (K : Iir_Kind) return Fields_Array @@ -4748,6 +4828,12 @@ package body Nodes_Meta is return Get_Prefix (N); when Field_Signature_Prefix => return Get_Signature_Prefix (N); + when Field_External_Pathname => + return Get_External_Pathname (N); + when Field_Pathname_Suffix => + return Get_Pathname_Suffix (N); + when Field_Pathname_Expression => + return Get_Pathname_Expression (N); when Field_Slice_Subtype => return Get_Slice_Subtype (N); when Field_Suffix => @@ -5108,6 +5194,12 @@ package body Nodes_Meta is Set_Prefix (N, V); when Field_Signature_Prefix => Set_Signature_Prefix (N, V); + when Field_External_Pathname => + Set_External_Pathname (N, V); + when Field_Pathname_Suffix => + Set_Pathname_Suffix (N, V); + when Field_Pathname_Expression => + Set_Pathname_Expression (N, V); when Field_Slice_Subtype => Set_Slice_Subtype (N, V); when Field_Suffix => @@ -6540,6 +6632,9 @@ package body Nodes_Meta is | Iir_Kind_Case_Statement | Iir_Kind_Procedure_Call_Statement | Iir_Kind_If_Statement + | Iir_Kind_External_Constant_Name + | Iir_Kind_External_Signal_Name + | Iir_Kind_External_Variable_Name | Iir_Kind_Delayed_Attribute | Iir_Kind_Stable_Attribute | Iir_Kind_Quiet_Attribute @@ -6678,6 +6773,9 @@ package body Nodes_Meta is | Iir_Kind_Operator_Symbol | Iir_Kind_Selected_By_All_Name | Iir_Kind_Parenthesis_Name + | Iir_Kind_External_Constant_Name + | Iir_Kind_External_Signal_Name + | Iir_Kind_External_Variable_Name | Iir_Kind_Base_Attribute | Iir_Kind_Left_Type_Attribute | Iir_Kind_Right_Type_Attribute @@ -6736,7 +6834,10 @@ package body Nodes_Meta is | Iir_Kind_Interface_Variable_Declaration | Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Interface_File_Declaration - | Iir_Kind_Allocator_By_Subtype => + | Iir_Kind_Allocator_By_Subtype + | Iir_Kind_External_Constant_Name + | Iir_Kind_External_Signal_Name + | Iir_Kind_External_Variable_Name => return True; when others => return False; @@ -6829,6 +6930,7 @@ package body Nodes_Meta is | Iir_Kind_Selected_Name | Iir_Kind_Operator_Symbol | Iir_Kind_Selected_By_All_Name + | Iir_Kind_Package_Pathname | Iir_Kind_Left_Type_Attribute | Iir_Kind_Right_Type_Attribute | Iir_Kind_High_Type_Attribute @@ -7023,7 +7125,15 @@ package body Nodes_Meta is function Has_Shared_Flag (K : Iir_Kind) return Boolean is begin - return K = Iir_Kind_Variable_Declaration; + case K is + when Iir_Kind_Variable_Declaration + | Iir_Kind_External_Constant_Name + | Iir_Kind_External_Signal_Name + | Iir_Kind_External_Variable_Name => + return True; + when others => + return False; + end case; end Has_Shared_Flag; function Has_Design_Unit (K : Iir_Kind) return Boolean is @@ -7263,6 +7373,8 @@ package body Nodes_Meta is | Iir_Kind_Simple_Name | Iir_Kind_Selected_Name | Iir_Kind_Operator_Symbol + | Iir_Kind_Package_Pathname + | Iir_Kind_Pathname_Element | Iir_Kind_Attribute_Name => return True; when others => @@ -8300,7 +8412,10 @@ package body Nodes_Meta is | Iir_Kind_Case_Statement | Iir_Kind_Procedure_Call_Statement | Iir_Kind_If_Statement - | Iir_Kind_Elsif => + | Iir_Kind_Elsif + | Iir_Kind_External_Constant_Name + | Iir_Kind_External_Signal_Name + | Iir_Kind_External_Variable_Name => return True; when others => return False; @@ -8382,6 +8497,8 @@ package body Nodes_Meta is | Iir_Kind_Operator_Symbol | Iir_Kind_Selected_By_All_Name | Iir_Kind_Parenthesis_Name + | Iir_Kind_Package_Pathname + | Iir_Kind_Pathname_Element | Iir_Kind_Attribute_Name => return True; when others => @@ -8491,6 +8608,9 @@ package body Nodes_Meta is | Iir_Kind_Simple_Name | Iir_Kind_Selected_Name | Iir_Kind_Selected_By_All_Name + | Iir_Kind_External_Constant_Name + | Iir_Kind_External_Signal_Name + | Iir_Kind_External_Variable_Name | Iir_Kind_Left_Type_Attribute | Iir_Kind_Right_Type_Attribute | Iir_Kind_High_Type_Attribute @@ -8701,6 +8821,9 @@ package body Nodes_Meta is | Iir_Kind_Character_Literal | Iir_Kind_Simple_Name | Iir_Kind_Selected_Name + | Iir_Kind_External_Constant_Name + | Iir_Kind_External_Signal_Name + | Iir_Kind_External_Variable_Name | Iir_Kind_Left_Type_Attribute | Iir_Kind_Right_Type_Attribute | Iir_Kind_High_Type_Attribute @@ -8804,6 +8927,36 @@ package body Nodes_Meta is return K = Iir_Kind_Signature; end Has_Signature_Prefix; + function Has_External_Pathname (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_External_Constant_Name + | Iir_Kind_External_Signal_Name + | Iir_Kind_External_Variable_Name => + return True; + when others => + return False; + end case; + end Has_External_Pathname; + + function Has_Pathname_Suffix (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Package_Pathname + | Iir_Kind_Absolute_Pathname + | Iir_Kind_Relative_Pathname + | Iir_Kind_Pathname_Element => + return True; + when others => + return False; + end case; + end Has_Pathname_Suffix; + + function Has_Pathname_Expression (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Pathname_Element; + end Has_Pathname_Expression; + function Has_Slice_Subtype (K : Iir_Kind) return Boolean is begin return K = Iir_Kind_Slice_Name; @@ -9415,7 +9568,10 @@ package body Nodes_Meta is | Iir_Kind_Interface_Constant_Declaration | Iir_Kind_Interface_Variable_Declaration | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Interface_File_Declaration => + | Iir_Kind_Interface_File_Declaration + | Iir_Kind_External_Constant_Name + | Iir_Kind_External_Signal_Name + | Iir_Kind_External_Variable_Name => return True; when others => return False; diff --git a/src/vhdl/nodes_meta.ads b/src/vhdl/nodes_meta.ads index 84071ff..5c740b5 100644 --- a/src/vhdl/nodes_meta.ads +++ b/src/vhdl/nodes_meta.ads @@ -289,6 +289,9 @@ package Nodes_Meta is Field_Name_Staticness, Field_Prefix, Field_Signature_Prefix, + Field_External_Pathname, + Field_Pathname_Suffix, + Field_Pathname_Expression, Field_Slice_Subtype, Field_Suffix, Field_Index_Subtype, @@ -770,6 +773,9 @@ package Nodes_Meta is function Has_Name_Staticness (K : Iir_Kind) return Boolean; function Has_Prefix (K : Iir_Kind) return Boolean; function Has_Signature_Prefix (K : Iir_Kind) return Boolean; + function Has_External_Pathname (K : Iir_Kind) return Boolean; + function Has_Pathname_Suffix (K : Iir_Kind) return Boolean; + function Has_Pathname_Expression (K : Iir_Kind) return Boolean; function Has_Slice_Subtype (K : Iir_Kind) return Boolean; function Has_Suffix (K : Iir_Kind) return Boolean; function Has_Index_Subtype (K : Iir_Kind) return Boolean; diff --git a/src/vhdl/parse.adb b/src/vhdl/parse.adb index 61df598..7cb8f82 100644 --- a/src/vhdl/parse.adb +++ b/src/vhdl/parse.adb @@ -882,6 +882,221 @@ package body Parse is end loop; end Parse_Name_Suffix; + -- Precond: next token + -- Postcond: next token + -- + -- LRM08 8.7 External names + -- + -- external_pathname ::= + -- package_pathname + -- | absolute_pathname + -- | relative_pathname + -- + -- package_pathname ::= + -- @ library_logical_name . package_simple_name . + -- { package_simple_name . } object_simple_name + -- + -- absolute_pathname ::= + -- . partial_pathname + -- + -- relative_pathname ::= + -- { ^ . } partial_pathname + -- + -- partial_pathname ::= { pathname_element . } object_simple_name + -- + -- pathname_element ::= + -- entity_simple_name + -- | component_instantiation_label + -- | block_label + -- | generate_statement_label [ ( static_expression ) ] + -- | package_simple_name + function Parse_External_Pathname return Iir + is + Res : Iir; + Last : Iir; + El : Iir; + begin + case Current_Token is + when Tok_Arobase => + Res := Create_Iir (Iir_Kind_Package_Pathname); + Set_Location (Res); + Last := Res; + + -- Skip '@' + Scan; + + if Current_Token /= Tok_Identifier then + Error_Msg_Parse ("library name expected after '@'"); + else + Set_Identifier (Res, Current_Identifier); + + -- Skip ident + Scan; + end if; + + if Current_Token /= Tok_Dot then + Error_Msg_Parse ("'.' expected after library name"); + else + -- Skip '.' + Scan; + end if; + + when Tok_Dot => + Res := Create_Iir (Iir_Kind_Absolute_Pathname); + Set_Location (Res); + Last := Res; + + -- Skip '.' + Scan; + + when Tok_Caret => + Last := Null_Iir; + loop + El := Create_Iir (Iir_Kind_Relative_Pathname); + Set_Location (El); + + -- Skip '^' + Scan; + + if Current_Token /= Tok_Dot then + Error_Msg_Parse ("'.' expected after '^'"); + else + -- Skip '.' + Scan; + end if; + + if Last = Null_Iir then + Res := El; + else + Set_Pathname_Suffix (Last, El); + end if; + Last := El; + + exit when Current_Token /= Tok_Caret; + end loop; + + when Tok_Identifier => + Last := Null_Iir; + + when others => + Last := Null_Iir; + -- Error is handled just below. + end case; + + -- Parse pathname elements. + loop + if Current_Token /= Tok_Identifier then + Error_Msg_Parse ("pathname element expected"); + -- FIXME: resync. + return Res; + end if; + + El := Create_Iir (Iir_Kind_Pathname_Element); + Set_Location (El); + Set_Identifier (El, Current_Identifier); + if Last = Null_Iir then + Res := El; + else + Set_Pathname_Suffix (Last, El); + end if; + Last := El; + + -- Skip identifier + Scan; + + exit when Current_Token /= Tok_Dot; + + -- Skip '.' + Scan; + end loop; + + return Res; + end Parse_External_Pathname; + + -- Precond: '<<' + -- Postcond: next token + -- + -- LRM08 8.7 External names + -- external_name ::= + -- external_constant_name + -- | external_signal_name + -- | external_variable_name + -- + -- external_constant_name ::= + -- << CONSTANT external_pathname : subtype_indication >> + -- + -- external_signal_name ::= + -- << SIGNAL external_pathname : subtype_indication >> + -- + -- external_variable_name ::= + -- << VARIABLE external_pathname : subtype_indication >> + function Parse_External_Name return Iir + is + Loc : Location_Type; + Res : Iir; + Kind : Iir_Kind; + begin + Loc := Get_Token_Location; + + -- Skip '<<' + Scan; + + case Current_Token is + when Tok_Constant => + Kind := Iir_Kind_External_Constant_Name; + -- Skip 'constant' + Scan; + when Tok_Signal => + Kind := Iir_Kind_External_Signal_Name; + -- Skip 'signal' + Scan; + when Tok_Variable => + Kind := Iir_Kind_External_Variable_Name; + -- Skip 'variable' + Scan; + when others => + Error_Msg_Parse + ("constant, signal or variable expected after <<"); + Kind := Iir_Kind_External_Signal_Name; + end case; + + Res := Create_Iir (Kind); + Set_Location (Res, Loc); + + Set_External_Pathname (Res, Parse_External_Pathname); + + if Current_Token /= Tok_Colon then + Error_Msg_Parse ("':' expected after external pathname"); + else + -- Skip ':' + Scan; + end if; + + Set_Subtype_Indication (Res, Parse_Subtype_Indication); + + if Current_Token /= Tok_Double_Greater then + Error_Msg_Parse ("'>>' expected at end of external name"); + else + -- Skip '>>' + Scan; + end if; + + return Res; + end Parse_External_Name; + + -- Precond: next token (identifier, string or '<<') + -- Postcond: next token + -- + -- LRM08 8. Names + -- name ::= + -- simple_name + -- | operator_symbol + -- | character_literal -- FIXME: not handled. + -- | selected_name + -- | indexed_name + -- | slice_name + -- | attribute_name + -- | external_name function Parse_Name (Allow_Indexes: Boolean := True) return Iir is Res: Iir; @@ -891,20 +1106,29 @@ package body Parse is Res := Create_Iir (Iir_Kind_Simple_Name); Set_Identifier (Res, Current_Identifier); Set_Location (Res); + + -- Skip identifier + Scan; + when Tok_String => -- For operator symbol, such as: "+" (A, B). Res := Create_Iir (Iir_Kind_String_Literal8); Set_String8_Id (Res, Current_String_Id); Set_String_Length (Res, Current_String_Length); Set_Location (Res); + + -- Skip string + Scan; + when Tok_Double_Less => + if Vhdl_Std < Vhdl_08 then + Error_Msg_Parse ("external name not allowed before vhdl 08"); + end if; + Res := Parse_External_Name; when others => Error_Msg_Parse ("identifier expected here"); raise Parse_Error; end case; - -- Skip identifier or string. - Scan; - return Parse_Name_Suffix (Res, Allow_Indexes); end Parse_Name; @@ -4192,7 +4416,8 @@ package body Parse is Set_Fp_Value (Res, Fp); return Res; - when Tok_Identifier => + when Tok_Identifier + | Tok_Double_Less => return Parse_Name (Allow_Indexes => True); when Tok_Character => Res := Current_Text; diff --git a/src/vhdl/scanner.adb b/src/vhdl/scanner.adb index 544cc74..84efbe4 100644 --- a/src/vhdl/scanner.adb +++ b/src/vhdl/scanner.adb @@ -1310,7 +1310,7 @@ package body Scanner is << Again >> null; -- Skip commonly used separators. - while Source(Pos) = ' ' or Source(Pos) = HT loop + while Source (Pos) = ' ' or Source (Pos) = HT loop Pos := Pos + 1; end loop; @@ -1561,25 +1561,33 @@ package body Scanner is end if; return; when '<' => - if Source (Pos + 1) = '=' then - Current_Token := Tok_Less_Equal; - Pos := Pos + 2; - elsif Source (Pos + 1) = '>' then - Current_Token := Tok_Box; - Pos := Pos + 2; - else - Current_Token := Tok_Less; - Pos := Pos + 1; - end if; + case Source (Pos + 1) is + when '=' => + Current_Token := Tok_Less_Equal; + Pos := Pos + 2; + when '>' => + Current_Token := Tok_Box; + Pos := Pos + 2; + when '<' => + Current_Token := Tok_Double_Less; + Pos := Pos + 2; + when others => + Current_Token := Tok_Less; + Pos := Pos + 1; + end case; return; when '>' => - if Source (Pos + 1) = '=' then - Current_Token := Tok_Greater_Equal; - Pos := Pos + 2; - else - Current_Token := Tok_Greater; - Pos := Pos + 1; - end if; + case Source (Pos + 1) is + when '=' => + Current_Token := Tok_Greater_Equal; + Pos := Pos + 2; + when '>' => + Current_Token := Tok_Double_Greater; + Pos := Pos + 2; + when others => + Current_Token := Tok_Greater; + Pos := Pos + 1; + end case; return; when '=' => if Source (Pos + 1) = '=' then @@ -1750,9 +1758,13 @@ package body Scanner is Scan_Extended_Identifier; return; when '^' => - Error_Msg_Scan ("'^' is not a VHDL operator, use 'xor'"); + if Vhdl_Std >= Vhdl_08 then + Current_Token := Tok_Caret; + else + Current_Token := Tok_Xor; + Error_Msg_Scan ("'^' is not a VHDL operator, use 'xor'"); + end if; Pos := Pos + 1; - Current_Token := Tok_Xor; return; when '~' => Error_Msg_Scan ("'~' is not a VHDL operator, use 'not'"); @@ -1807,7 +1819,7 @@ package body Scanner is Pos := Pos + 1; goto Again; when '@' => - if Flag_Psl then + if Vhdl_Std >= Vhdl_08 or Flag_Psl then Current_Token := Tok_Arobase; Pos := Pos + 1; return; diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb index c8722b6..bbc9aaa 100644 --- a/src/vhdl/sem_expr.adb +++ b/src/vhdl/sem_expr.adb @@ -393,6 +393,8 @@ package body Sem_Expr is | Iir_Kind_Unit_Declaration | Iir_Kind_Enumeration_Literal => return Expr; + when Iir_Kinds_External_Name => + return Expr; when Iir_Kinds_Object_Declaration | Iir_Kind_Aggregate | Iir_Kind_Allocator_By_Expression @@ -3826,6 +3828,8 @@ package body Sem_Expr is return; when Iir_Kinds_Quantity_Declaration => return; + when Iir_Kinds_External_Name => + return; when Iir_Kind_File_Declaration | Iir_Kind_Interface_File_Declaration => -- LRM 4.3.2 Interface declarations @@ -4004,6 +4008,10 @@ package body Sem_Expr is return E; end; + when Iir_Kinds_External_Name => + Sem_External_Name (Expr); + return Expr; + when Iir_Kinds_Monadic_Operator => return Sem_Operator (Expr, A_Type, 1); diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb index 66bd048..478499d 100644 --- a/src/vhdl/sem_names.adb +++ b/src/vhdl/sem_names.adb @@ -2415,6 +2415,7 @@ package body Sem_Names is | Iir_Kind_Implicit_Dereference | Iir_Kind_Selected_Element | Iir_Kind_Attribute_Value + | Iir_Kind_Simple_Name_Attribute | Iir_Kind_Function_Call => Add_Result (Res, Sem_As_Indexed_Or_Slice_Name (Prefix, True)); @@ -3883,6 +3884,24 @@ package body Sem_Names is end case; end Sem_Denoting_Name; + procedure Sem_External_Name (Name : Iir) + is + Atype : Iir; + begin + pragma Assert (Get_Type (Name) = Null_Iir); + + Atype := Get_Subtype_Indication (Name); + + Atype := Sem_Types.Sem_Subtype_Indication (Atype); + Set_Subtype_Indication (Name, Atype); + Atype := Get_Type_Of_Subtype_Indication (Atype); + if Atype = Null_Iir then + Atype := Create_Error_Type (Null_Iir); + end if; + + Set_Type (Name, Atype); + end Sem_External_Name; + function Sem_Terminal_Name (Name : Iir) return Iir is Res : Iir; diff --git a/src/vhdl/sem_names.ads b/src/vhdl/sem_names.ads index 3bc8530..3ce4acf 100644 --- a/src/vhdl/sem_names.ads +++ b/src/vhdl/sem_names.ads @@ -151,6 +151,9 @@ package Sem_Names is -- Like Sem_Denoting_Name but expect a terminal name. function Sem_Terminal_Name (Name : Iir) return Iir; + -- Analyze an external name. + procedure Sem_External_Name (Name : Iir); + -- Emit an error for NAME that doesn't match its class CLASS_NAME. procedure Error_Class_Match (Name : Iir; Class_Name : String); diff --git a/src/vhdl/tokens.adb b/src/vhdl/tokens.adb index e1bdfef..97062b7 100644 --- a/src/vhdl/tokens.adb +++ b/src/vhdl/tokens.adb @@ -113,6 +113,13 @@ package body Tokens is when Tok_Condition => return "??"; + when Tok_Double_Less => + return "<<"; + when Tok_Double_Greater => + return ">>"; + when Tok_Caret => + return "^"; + -- multiplying operator when Tok_Star => return "*"; diff --git a/src/vhdl/tokens.ads b/src/vhdl/tokens.ads index fc4b77f..aaabaa6 100644 --- a/src/vhdl/tokens.ads +++ b/src/vhdl/tokens.ads @@ -79,7 +79,11 @@ package Tokens is -- and adding_operator Tok_Ampersand, -- & + -- VHDL 2008 Tok_Condition, -- ?? + Tok_Double_Less, -- << + Tok_Double_Greater, -- >> + Tok_Caret, -- ^ -- PSL Tok_And_And, -- && |