diff options
| -rw-r--r-- | evaluation.adb | 67 | ||||
| -rw-r--r-- | iirs.adb | 77 | ||||
| -rw-r--r-- | iirs.ads | 64 | ||||
| -rw-r--r-- | iirs_utils.adb | 37 | ||||
| -rw-r--r-- | libraries/Makefile.inc | 36 | ||||
| -rw-r--r-- | parse.adb | 190 | ||||
| -rw-r--r-- | scan.adb | 39 | ||||
| -rw-r--r-- | sem.adb | 23 | ||||
| -rw-r--r-- | sem_decls.adb | 449 | ||||
| -rw-r--r-- | sem_expr.adb | 50 | ||||
| -rw-r--r-- | sem_expr.ads | 6 | ||||
| -rw-r--r-- | sem_names.adb | 2 | ||||
| -rw-r--r-- | sem_scopes.adb | 12 | ||||
| -rw-r--r-- | sem_scopes.ads | 4 | ||||
| -rw-r--r-- | sem_specs.adb | 4 | ||||
| -rw-r--r-- | sem_stmts.adb | 24 | ||||
| -rw-r--r-- | sem_types.adb | 10 | ||||
| -rw-r--r-- | std_names.adb | 23 | ||||
| -rw-r--r-- | std_names.ads | 84 | ||||
| -rw-r--r-- | std_package.adb | 140 | ||||
| -rw-r--r-- | std_package.ads | 4 | ||||
| -rw-r--r-- | tokens.adb | 15 | ||||
| -rw-r--r-- | tokens.ads | 9 | ||||
| -rw-r--r-- | translate/ghdldrv/Makefile | 2 | ||||
| -rw-r--r-- | translate/translation.adb | 8 |
25 files changed, 1025 insertions, 354 deletions
diff --git a/evaluation.adb b/evaluation.adb index d81903b77..e5d456004 100644 --- a/evaluation.adb +++ b/evaluation.adb @@ -926,6 +926,13 @@ package body Evaluation is when Iir_Predefined_Integer_Less => return Build_Boolean (Get_Value (Left) < Get_Value (Right), Orig); + when Iir_Predefined_Integer_Minimum => + return Build_Integer + (Iir_Int64'Min (Get_Value (Left), Get_Value (Right)), Orig); + when Iir_Predefined_Integer_Maximum => + return Build_Integer + (Iir_Int64'Max (Get_Value (Left), Get_Value (Right)), Orig); + when Iir_Predefined_Floating_Equality => return Build_Boolean (Get_Fp_Value (Left) = Get_Fp_Value (Right), Orig); @@ -984,6 +991,13 @@ package body Evaluation is return Build_Floating (Res, Orig); end; + when Iir_Predefined_Floating_Minimum => + return Build_Floating + (Iir_Fp64'Min (Get_Fp_Value (Left), Get_Fp_Value (Right)), Orig); + when Iir_Predefined_Floating_Maximum => + return Build_Floating + (Iir_Fp64'Max (Get_Fp_Value (Left), Get_Fp_Value (Right)), Orig); + when Iir_Predefined_Physical_Equality => return Build_Boolean (Get_Physical_Value (Left) = Get_Physical_Value (Right), Orig); @@ -1037,31 +1051,57 @@ package body Evaluation is (Iir_Int64 (Iir_Fp64 (Get_Physical_Value (Left)) / Get_Fp_Value (Right)), Orig); + when Iir_Predefined_Physical_Minimum => + return Build_Physical (Iir_Int64'Min (Get_Physical_Value (Left), + Get_Physical_Value (Right)), + Orig); + when Iir_Predefined_Physical_Maximum => + return Build_Physical (Iir_Int64'Max (Get_Physical_Value (Left), + Get_Physical_Value (Right)), + Orig); + when Iir_Predefined_Element_Array_Concat | Iir_Predefined_Array_Element_Concat | Iir_Predefined_Array_Array_Concat | Iir_Predefined_Element_Element_Concat => return Eval_Concatenation (Left, Right, Orig, Func); - when Iir_Predefined_Enum_Equality => + when Iir_Predefined_Enum_Equality + | Iir_Predefined_Bit_Match_Equality => return Build_Boolean (Get_Enum_Pos (Left) = Get_Enum_Pos (Right), Orig); - when Iir_Predefined_Enum_Inequality => + when Iir_Predefined_Enum_Inequality + | Iir_Predefined_Bit_Match_Inequality => return Build_Boolean (Get_Enum_Pos (Left) /= Get_Enum_Pos (Right), Orig); - when Iir_Predefined_Enum_Greater_Equal => + when Iir_Predefined_Enum_Greater_Equal + | Iir_Predefined_Bit_Match_Greater_Equal => return Build_Boolean (Get_Enum_Pos (Left) >= Get_Enum_Pos (Right), Orig); - when Iir_Predefined_Enum_Greater => + when Iir_Predefined_Enum_Greater + | Iir_Predefined_Bit_Match_Greater => return Build_Boolean (Get_Enum_Pos (Left) > Get_Enum_Pos (Right), Orig); - when Iir_Predefined_Enum_Less_Equal => + when Iir_Predefined_Enum_Less_Equal + | Iir_Predefined_Bit_Match_Less_Equal => return Build_Boolean (Get_Enum_Pos (Left) <= Get_Enum_Pos (Right), Orig); - when Iir_Predefined_Enum_Less => + when Iir_Predefined_Enum_Less + | Iir_Predefined_Bit_Match_Less => return Build_Boolean (Get_Enum_Pos (Left) < Get_Enum_Pos (Right), Orig); + when Iir_Predefined_Enum_Minimum => + return Build_Enumeration + (Iir_Index32 (Iir_Int32'Min (Get_Enum_Pos (Left), + Get_Enum_Pos (Right))), + Orig); + when Iir_Predefined_Enum_Maximum => + return Build_Enumeration + (Iir_Index32 (Iir_Int32'Max (Get_Enum_Pos (Left), + Get_Enum_Pos (Right))), + Orig); + when Iir_Predefined_Boolean_And | Iir_Predefined_Bit_And => return Build_Boolean @@ -1133,7 +1173,11 @@ package body Evaluation is Iir_Predefined_Functions'Image (Func)); when Iir_Predefined_Boolean_Not + | Iir_Predefined_Boolean_Rising_Edge + | Iir_Predefined_Boolean_Falling_Edge | Iir_Predefined_Bit_Not + | Iir_Predefined_Bit_Rising_Edge + | Iir_Predefined_Bit_Falling_Edge | Iir_Predefined_Integer_Absolute | Iir_Predefined_Integer_Identity | Iir_Predefined_Integer_Negation @@ -1180,7 +1224,16 @@ package body Evaluation is | Iir_Predefined_Array_To_String => -- Not binary or never locally static. Error_Internal (Orig, "eval_dyadic_operator: " & - Iir_Predefined_Functions'Image (Func)); + Iir_Predefined_Functions'Image (Func)); + + when Iir_Predefined_Std_Ulogic_Match_Equality + | Iir_Predefined_Std_Ulogic_Match_Inequality + | Iir_Predefined_Std_Ulogic_Match_Less + | Iir_Predefined_Std_Ulogic_Match_Less_Equal + | Iir_Predefined_Std_Ulogic_Match_Greater + | Iir_Predefined_Std_Ulogic_Match_Greater_Equal => + -- TODO + raise Program_Error; end case; exception when Constraint_Error => @@ -396,6 +396,13 @@ package body Iirs is | Iir_Kind_Negation_Operator | Iir_Kind_Absolute_Operator | Iir_Kind_Not_Operator + | Iir_Kind_Condition_Operator + | Iir_Kind_Reduction_And_Operator + | Iir_Kind_Reduction_Or_Operator + | Iir_Kind_Reduction_Nand_Operator + | Iir_Kind_Reduction_Nor_Operator + | Iir_Kind_Reduction_Xor_Operator + | Iir_Kind_Reduction_Xnor_Operator | Iir_Kind_And_Operator | Iir_Kind_Or_Operator | Iir_Kind_Nand_Operator @@ -408,6 +415,12 @@ package body Iirs is | Iir_Kind_Less_Than_Or_Equal_Operator | Iir_Kind_Greater_Than_Operator | Iir_Kind_Greater_Than_Or_Equal_Operator + | Iir_Kind_Match_Equality_Operator + | Iir_Kind_Match_Inequality_Operator + | Iir_Kind_Match_Less_Than_Operator + | Iir_Kind_Match_Less_Than_Or_Equal_Operator + | Iir_Kind_Match_Greater_Than_Operator + | Iir_Kind_Match_Greater_Than_Or_Equal_Operator | Iir_Kind_Sll_Operator | Iir_Kind_Sla_Operator | Iir_Kind_Srl_Operator @@ -2290,6 +2303,13 @@ package body Iirs is | Iir_Kind_Negation_Operator | Iir_Kind_Absolute_Operator | Iir_Kind_Not_Operator + | Iir_Kind_Condition_Operator + | Iir_Kind_Reduction_And_Operator + | Iir_Kind_Reduction_Or_Operator + | Iir_Kind_Reduction_Nand_Operator + | Iir_Kind_Reduction_Nor_Operator + | Iir_Kind_Reduction_Xor_Operator + | Iir_Kind_Reduction_Xnor_Operator | Iir_Kind_And_Operator | Iir_Kind_Or_Operator | Iir_Kind_Nand_Operator @@ -2302,6 +2322,12 @@ package body Iirs is | Iir_Kind_Less_Than_Or_Equal_Operator | Iir_Kind_Greater_Than_Operator | Iir_Kind_Greater_Than_Or_Equal_Operator + | Iir_Kind_Match_Equality_Operator + | Iir_Kind_Match_Inequality_Operator + | Iir_Kind_Match_Less_Than_Operator + | Iir_Kind_Match_Less_Than_Or_Equal_Operator + | Iir_Kind_Match_Greater_Than_Operator + | Iir_Kind_Match_Greater_Than_Or_Equal_Operator | Iir_Kind_Sll_Operator | Iir_Kind_Sla_Operator | Iir_Kind_Srl_Operator @@ -5687,6 +5713,13 @@ package body Iirs is | Iir_Kind_Negation_Operator | Iir_Kind_Absolute_Operator | Iir_Kind_Not_Operator + | Iir_Kind_Condition_Operator + | Iir_Kind_Reduction_And_Operator + | Iir_Kind_Reduction_Or_Operator + | Iir_Kind_Reduction_Nand_Operator + | Iir_Kind_Reduction_Nor_Operator + | Iir_Kind_Reduction_Xor_Operator + | Iir_Kind_Reduction_Xnor_Operator | Iir_Kind_And_Operator | Iir_Kind_Or_Operator | Iir_Kind_Nand_Operator @@ -5699,6 +5732,12 @@ package body Iirs is | Iir_Kind_Less_Than_Or_Equal_Operator | Iir_Kind_Greater_Than_Operator | Iir_Kind_Greater_Than_Or_Equal_Operator + | Iir_Kind_Match_Equality_Operator + | Iir_Kind_Match_Inequality_Operator + | Iir_Kind_Match_Less_Than_Operator + | Iir_Kind_Match_Less_Than_Or_Equal_Operator + | Iir_Kind_Match_Greater_Than_Operator + | Iir_Kind_Match_Greater_Than_Or_Equal_Operator | Iir_Kind_Sll_Operator | Iir_Kind_Sla_Operator | Iir_Kind_Srl_Operator @@ -5809,7 +5848,14 @@ package body Iirs is when Iir_Kind_Identity_Operator | Iir_Kind_Negation_Operator | Iir_Kind_Absolute_Operator - | Iir_Kind_Not_Operator => + | Iir_Kind_Not_Operator + | Iir_Kind_Condition_Operator + | Iir_Kind_Reduction_And_Operator + | Iir_Kind_Reduction_Or_Operator + | Iir_Kind_Reduction_Nand_Operator + | Iir_Kind_Reduction_Nor_Operator + | Iir_Kind_Reduction_Xor_Operator + | Iir_Kind_Reduction_Xnor_Operator => null; when others => Failed ("Operand", Target); @@ -5843,6 +5889,12 @@ package body Iirs is | Iir_Kind_Less_Than_Or_Equal_Operator | Iir_Kind_Greater_Than_Operator | Iir_Kind_Greater_Than_Or_Equal_Operator + | Iir_Kind_Match_Equality_Operator + | Iir_Kind_Match_Inequality_Operator + | Iir_Kind_Match_Less_Than_Operator + | Iir_Kind_Match_Less_Than_Or_Equal_Operator + | Iir_Kind_Match_Greater_Than_Operator + | Iir_Kind_Match_Greater_Than_Or_Equal_Operator | Iir_Kind_Sll_Operator | Iir_Kind_Sla_Operator | Iir_Kind_Srl_Operator @@ -5890,6 +5942,12 @@ package body Iirs is | Iir_Kind_Less_Than_Or_Equal_Operator | Iir_Kind_Greater_Than_Operator | Iir_Kind_Greater_Than_Or_Equal_Operator + | Iir_Kind_Match_Equality_Operator + | Iir_Kind_Match_Inequality_Operator + | Iir_Kind_Match_Less_Than_Operator + | Iir_Kind_Match_Less_Than_Or_Equal_Operator + | Iir_Kind_Match_Greater_Than_Operator + | Iir_Kind_Match_Greater_Than_Or_Equal_Operator | Iir_Kind_Sll_Operator | Iir_Kind_Sla_Operator | Iir_Kind_Srl_Operator @@ -5949,7 +6007,6 @@ package body Iirs is begin case Get_Kind (Target) is when Iir_Kind_Choice_By_Name - | Iir_Kind_Signature | Iir_Kind_Non_Object_Alias_Declaration | Iir_Kind_Object_Alias_Declaration => null; @@ -6049,7 +6106,8 @@ package body Iirs is procedure Check_Kind_For_Prefix (Target : Iir) is begin case Get_Kind (Target) is - when Iir_Kind_Selected_Element + when Iir_Kind_Signature + | Iir_Kind_Selected_Element | Iir_Kind_Dereference | Iir_Kind_Implicit_Dereference | Iir_Kind_Slice_Name @@ -6576,6 +6634,13 @@ package body Iirs is | Iir_Kind_Negation_Operator | Iir_Kind_Absolute_Operator | Iir_Kind_Not_Operator + | Iir_Kind_Condition_Operator + | Iir_Kind_Reduction_And_Operator + | Iir_Kind_Reduction_Or_Operator + | Iir_Kind_Reduction_Nand_Operator + | Iir_Kind_Reduction_Nor_Operator + | Iir_Kind_Reduction_Xor_Operator + | Iir_Kind_Reduction_Xnor_Operator | Iir_Kind_And_Operator | Iir_Kind_Or_Operator | Iir_Kind_Nand_Operator @@ -6588,6 +6653,12 @@ package body Iirs is | Iir_Kind_Less_Than_Or_Equal_Operator | Iir_Kind_Greater_Than_Operator | Iir_Kind_Greater_Than_Or_Equal_Operator + | Iir_Kind_Match_Equality_Operator + | Iir_Kind_Match_Inequality_Operator + | Iir_Kind_Match_Less_Than_Operator + | Iir_Kind_Match_Less_Than_Or_Equal_Operator + | Iir_Kind_Match_Greater_Than_Operator + | Iir_Kind_Match_Greater_Than_Or_Equal_Operator | Iir_Kind_Sll_Operator | Iir_Kind_Sla_Operator | Iir_Kind_Srl_Operator @@ -590,8 +590,7 @@ package Iirs is -- -- Get/Set_Type_Marks_List (Field2) -- - -- Used only for attribute specification. - -- Get/Set_Name (Field4) + -- Get/Set_Prefix (Field3) -- Iir_Kind_Overload_List (Short) -- @@ -2823,6 +2822,13 @@ package Iirs is Iir_Kind_Negation_Operator, Iir_Kind_Absolute_Operator, Iir_Kind_Not_Operator, + Iir_Kind_Condition_Operator, + Iir_Kind_Reduction_And_Operator, + Iir_Kind_Reduction_Or_Operator, + Iir_Kind_Reduction_Nand_Operator, + Iir_Kind_Reduction_Nor_Operator, + Iir_Kind_Reduction_Xor_Operator, + Iir_Kind_Reduction_Xnor_Operator, Iir_Kind_And_Operator, Iir_Kind_Or_Operator, Iir_Kind_Nand_Operator, @@ -2835,6 +2841,12 @@ package Iirs is Iir_Kind_Less_Than_Or_Equal_Operator, Iir_Kind_Greater_Than_Operator, Iir_Kind_Greater_Than_Or_Equal_Operator, + Iir_Kind_Match_Equality_Operator, + Iir_Kind_Match_Inequality_Operator, + Iir_Kind_Match_Less_Than_Operator, + Iir_Kind_Match_Less_Than_Or_Equal_Operator, + Iir_Kind_Match_Greater_Than_Operator, + Iir_Kind_Match_Greater_Than_Or_Equal_Operator, Iir_Kind_Sll_Operator, Iir_Kind_Sla_Operator, Iir_Kind_Srl_Operator, @@ -3015,6 +3027,9 @@ package Iirs is Iir_Predefined_Boolean_Xnor, Iir_Predefined_Boolean_Not, + Iir_Predefined_Boolean_Rising_Edge, + Iir_Predefined_Boolean_Falling_Edge, + -- Predefined operators for any enumeration type. Iir_Predefined_Enum_Equality, Iir_Predefined_Enum_Inequality, @@ -3023,6 +3038,9 @@ package Iirs is Iir_Predefined_Enum_Greater, Iir_Predefined_Enum_Greater_Equal, + Iir_Predefined_Enum_Minimum, + Iir_Predefined_Enum_Maximum, + -- Predefined operators for BIT type. Iir_Predefined_Bit_And, Iir_Predefined_Bit_Or, @@ -3032,6 +3050,16 @@ package Iirs is Iir_Predefined_Bit_Xnor, Iir_Predefined_Bit_Not, + Iir_Predefined_Bit_Match_Equality, + Iir_Predefined_Bit_Match_Inequality, + Iir_Predefined_Bit_Match_Less, + Iir_Predefined_Bit_Match_Less_Equal, + Iir_Predefined_Bit_Match_Greater, + Iir_Predefined_Bit_Match_Greater_Equal, + + Iir_Predefined_Bit_Rising_Edge, + Iir_Predefined_Bit_Falling_Edge, + -- Predefined operators for any integer type. Iir_Predefined_Integer_Equality, Iir_Predefined_Integer_Inequality, @@ -3053,6 +3081,9 @@ package Iirs is Iir_Predefined_Integer_Exp, + Iir_Predefined_Integer_Minimum, + Iir_Predefined_Integer_Maximum, + -- Predefined operators for any floating type. Iir_Predefined_Floating_Equality, Iir_Predefined_Floating_Inequality, @@ -3072,6 +3103,9 @@ package Iirs is Iir_Predefined_Floating_Exp, + Iir_Predefined_Floating_Minimum, + Iir_Predefined_Floating_Maximum, + -- Predefined operator for universal types. Iir_Predefined_Universal_R_I_Mul, Iir_Predefined_Universal_I_R_Mul, @@ -3100,6 +3134,9 @@ package Iirs is Iir_Predefined_Physical_Real_Div, Iir_Predefined_Physical_Physical_Div, + Iir_Predefined_Physical_Minimum, + Iir_Predefined_Physical_Maximum, + -- Predefined operators for access. Iir_Predefined_Access_Equality, Iir_Predefined_Access_Inequality, @@ -3181,6 +3218,14 @@ package Iirs is -- To_String Iir_Predefined_Array_To_String, + -- IEEE.Std_Logic_1164.Std_Ulogic + Iir_Predefined_Std_Ulogic_Match_Equality, + Iir_Predefined_Std_Ulogic_Match_Inequality, + Iir_Predefined_Std_Ulogic_Match_Less, + Iir_Predefined_Std_Ulogic_Match_Less_Equal, + Iir_Predefined_Std_Ulogic_Match_Greater, + Iir_Predefined_Std_Ulogic_Match_Greater_Equal, + -- Predefined function. Iir_Predefined_Now_Function ); @@ -3377,7 +3422,14 @@ package Iirs is Iir_Kind_Identity_Operator .. --Iir_Kind_Negation_Operator --Iir_Kind_Absolute_Operator - Iir_Kind_Not_Operator; + --Iir_Kind_Not_Operator + --Iir_Kind_Condition_Operator + --Iir_Kind_Reduction_And_Operator + --Iir_Kind_Reduction_Or_Operator + --Iir_Kind_Reduction_Nand_Operator + --Iir_Kind_Reduction_Nor_Operator + --Iir_Kind_Reduction_Xor_Operator + Iir_Kind_Reduction_Xnor_Operator; subtype Iir_Kinds_Dyadic_Operator is Iir_Kind range Iir_Kind_And_Operator .. @@ -3392,6 +3444,12 @@ package Iirs is --Iir_Kind_Less_Than_Or_Equal_Operator --Iir_Kind_Greater_Than_Operator --Iir_Kind_Greater_Than_Or_Equal_Operator + --Iir_Kind_Match_Equality_Operator + --Iir_Kind_Match_Inequality_Operator + --Iir_Kind_Match_Less_Than_Operator + --Iir_Kind_Match_Less_Than_Or_Equal_Operator + --Iir_Kind_Match_Greater_Than_Operator + --Iir_Kind_Match_Greater_Than_Or_Equal_Operator --Iir_Kind_Sll_Operator --Iir_Kind_Sla_Operator --Iir_Kind_Srl_Operator diff --git a/iirs_utils.adb b/iirs_utils.adb index 35cbbef23..3699baa4d 100644 --- a/iirs_utils.adb +++ b/iirs_utils.adb @@ -48,18 +48,25 @@ package body Iirs_Utils is function Get_Operator_Name (Op : Iir) return Name_Id is begin case Get_Kind (Op) is - when Iir_Kind_And_Operator => + when Iir_Kind_And_Operator + | Iir_Kind_Reduction_And_Operator => return Name_And; - when Iir_Kind_Or_Operator => + when Iir_Kind_Or_Operator + | Iir_Kind_Reduction_Or_Operator => return Name_Or; - when Iir_Kind_Nand_Operator => + when Iir_Kind_Nand_Operator + | Iir_Kind_Reduction_Nand_Operator => return Name_Nand; - when Iir_Kind_Nor_Operator => + when Iir_Kind_Nor_Operator + | Iir_Kind_Reduction_Nor_Operator => return Name_Nor; - when Iir_Kind_Xor_Operator => + when Iir_Kind_Xor_Operator + | Iir_Kind_Reduction_Xor_Operator => return Name_Xor; - when Iir_Kind_Xnor_Operator => + when Iir_Kind_Xnor_Operator + | Iir_Kind_Reduction_Xnor_Operator => return Name_Xnor; + when Iir_Kind_Equality_Operator => return Name_Op_Equality; when Iir_Kind_Inequality_Operator => @@ -72,6 +79,20 @@ package body Iirs_Utils is return Name_Op_Greater; when Iir_Kind_Greater_Than_Or_Equal_Operator => return Name_Op_Greater_Equal; + + when Iir_Kind_Match_Equality_Operator => + return Name_Op_Match_Equality; + when Iir_Kind_Match_Inequality_Operator => + return Name_Op_Match_Inequality; + when Iir_Kind_Match_Less_Than_Operator => + return Name_Op_Match_Less; + when Iir_Kind_Match_Less_Than_Or_Equal_Operator => + return Name_Op_Match_Less_Equal; + when Iir_Kind_Match_Greater_Than_Operator => + return Name_Op_Match_Greater; + when Iir_Kind_Match_Greater_Than_Or_Equal_Operator => + return Name_Op_Match_Greater_Equal; + when Iir_Kind_Sll_Operator => return Name_Sll; when Iir_Kind_Sla_Operator => @@ -108,6 +129,8 @@ package body Iirs_Utils is return Name_Op_Plus; when Iir_Kind_Absolute_Operator => return Name_Abs; + when Iir_Kind_Condition_Operator => + return Name_Op_Condition; when others => raise Internal_Error; end case; @@ -730,7 +753,7 @@ package body Iirs_Utils is Res : Iir; begin Res := Create_Iir (Iir_Kind_Error); - Set_Expr_Staticness (Res, Locally); + Set_Expr_Staticness (Res, None); Set_Type (Res, Atype); Set_Error_Origin (Res, Orig); Location_Copy (Res, Orig); diff --git a/libraries/Makefile.inc b/libraries/Makefile.inc index 24e9ec5f4..a7c51a2c7 100644 --- a/libraries/Makefile.inc +++ b/libraries/Makefile.inc @@ -17,6 +17,7 @@ # 02111-1307, USA. # Variable to be defined: +# LIB08_DIR # LIB93_DIR # LIB87_DIR # REL_DIR @@ -43,8 +44,26 @@ VITAL2000_BSRCS := vital2000/timing_p.vhdl vital2000/timing_b.vhdl \ SYNOPSYS_BSRCS := synopsys/std_logic_arith.vhdl \ synopsys/std_logic_textio.vhdl synopsys/std_logic_unsigned.vhdl \ synopsys/std_logic_signed.vhdl \ - synopsys/std_logic_misc.vhdl synopsys/std_logic_misc-body.vhdl + synopsys/std_logic_misc.vhdl synopsys/std_logic_misc-body.vhdl MENTOR_BSRCS := mentor/std_logic_arith.vhdl mentor/std_logic_arith_body.vhdl +IEEE08_BSRCS := \ +ieee2008/std_logic_1164.vhdl ieee2008/std_logic_1164-body.vhdl \ +ieee2008/std_logic_textio.vhdl \ +ieee2008/math_real.vhdl ieee2008/math_real-body.vhdl \ +ieee2008/math_complex.vhdl ieee2008/math_complex-body.vhdl \ +ieee2008/numeric_bit.vhdl \ +ieee2008/numeric_bit_unsigned.vhdl ieee2008/numeric_bit_unsigned-body.vhdl \ +ieee2008/numeric_std.vhdl \ +ieee2008/numeric_std-body.vhdl \ +ieee2008/numeric_std_unsigned.vhdl ieee2008/numeric_std_unsigned-body.vhdl +# ieee2008/numeric_bit-body.vhdl \ +#ieee2008/fixed_float_types.vhdl +#ieee2008/fixed_generic_pkg-body.vhdl +#ieee2008/fixed_generic_pkg.vhdl +#ieee2008/fixed_pkg.vhdl +#ieee2008/float_generic_pkg-body.vhdl +#ieee2008/float_generic_pkg.vhdl +#ieee2008/float_pkg.vhdl STD87_BSRCS := $(STD_SRCS:.vhdl=.v87) STD93_BSRCS := $(STD_SRCS:.vhdl=.v93) @@ -77,6 +96,7 @@ SYN93_DIR:=$(LIB93_DIR)/synopsys MENTOR93_DIR:=$(LIB93_DIR)/mentor STD08_DIR:=$(LIB08_DIR)/std +IEEE08_DIR:=$(LIB08_DIR)/ieee ANALYZE87:=$(ANALYZE) --std=87 ANALYZE93:=$(ANALYZE) --std=93 @@ -88,6 +108,7 @@ STD08_SRCS=$(addprefix $(LIBSRC_DIR)/,$(STD08_BSRCS)) IEEE93_SRCS=$(addprefix $(LIBSRC_DIR)/,$(IEEE93_BSRCS)) IEEE87_SRCS=$(addprefix $(LIBSRC_DIR)/,$(IEEE87_BSRCS)) +IEEE08_SRCS=$(addprefix $(LIBSRC_DIR)/,$(IEEE08_BSRCS)) SYNOPSYS_SRCS=$(addprefix $(LIBSRC_DIR)/,$(SYNOPSYS_BSRCS)) MENTOR93_SRCS=$(addprefix $(LIBSRC_DIR)/,$(MENTOR93_BSRCS)) VITAL95_SRCS=$(addprefix $(LIBSRC_DIR)/,$(VITAL95_BSRCS)) @@ -190,3 +211,16 @@ std.v08: $(LIB08_DIR) $(STD08_SRCS) force $(ANALYZE08) --bootstrap --work=std $(REL_DIR)/$$i || exit 1; \ done; \ cd $$prev + +ANALYZE_IEEE08=$(ANALYZE08) -P../std --work=ieee + +ieee.v08: $(LIB08_DIR) $(IEEE08_SRCS) force + $(RM) -rf $(IEEE08_DIR) + mkdir $(IEEE08_DIR) +# FIXME: add VITAL2000 ? + prev=`pwd`; cd $(IEEE08_DIR); \ + for i in $(IEEE08_BSRCS); do \ + cmd="$(ANALYZE_IEEE08) $(REL_DIR)/$(LIBSRC_DIR)/$$i"; \ + echo $$cmd; eval $$cmd || exit 1; \ + done; \ + cd $$prev @@ -513,10 +513,19 @@ package body Parse is when '?' => if Vhdl_Std < Vhdl_08 then Bad_Operator_Symbol; - elsif C2 /= '?' then + Id := Name_Op_Condition; + elsif C2 = '?' then + Id := Name_Op_Condition; + elsif C2 = '=' then + Id := Name_Op_Match_Equality; + elsif C2 = '<' then + Id := Name_Op_Match_Less; + elsif C2 = '>' then + Id := Name_Op_Match_Greater; + else Bad_Operator_Symbol; + Id := Name_Op_Condition; end if; - Id := Name_Op_Condition; when others => Bad_Operator_Symbol; Id := Name_Op_Equality; @@ -612,6 +621,22 @@ package body Parse is Id := Name_Rem; Bad_Operator_Symbol; end if; + when '?' => + if Vhdl_Std < Vhdl_08 then + Bad_Operator_Symbol; + Id := Name_Op_Match_Less_Equal; + else + if C2 = '<' and C3 = '=' then + Id := Name_Op_Match_Less_Equal; + elsif C2 = '>' and C3 = '=' then + Id := Name_Op_Match_Greater_Equal; + elsif C2 = '/' and C3 = '=' then + Id := Name_Op_Match_Inequality; + else + Bad_Operator_Symbol; + Id := Name_Op_Match_Less_Equal; + end if; + end if; when others => Id := Name_And; Bad_Operator_Symbol; @@ -719,6 +744,13 @@ package body Parse is -- -- [ §6.6 ] -- attribute_designator ::= ATTRIBUTE_simple_name + -- + -- Note: in order to simplify the parsing, this function may return a + -- signature without attribute designator. Signatures may appear at 3 + -- places: + -- - in attribute name + -- - in alias declaration + -- - in entity designator function Parse_Name_Suffix (Pfx : Iir; Allow_Indexes: Boolean := True) return Iir is @@ -731,30 +763,14 @@ package body Parse is case Current_Token is when Tok_Left_Bracket => - if not Allow_Indexes then - return Res; - end if; - if Get_Kind (Prefix) = Iir_Kind_String_Literal then Prefix := String_To_Operator_Symbol (Prefix); end if; - -- There is an attribute with a signature. - Res := Create_Iir (Iir_Kind_Attribute_Name); + -- There is a signature. They are normally followed by an + -- attribute. + Res := Parse_Signature; Set_Prefix (Res, Prefix); - Set_Signature (Res, Parse_Signature); - if Current_Token /= Tok_Tick then - Error_Msg_Parse ("' is expected after a signature"); - else - Set_Location (Res); - Scan.Scan; - if Current_Token /= Tok_Identifier then - Error_Msg_Parse ("attribute_designator expected after '"); - else - Set_Attribute_Identifier (Res, Current_Identifier); - Scan.Scan; - end if; - end if; when Tok_Tick => -- There is an attribute. @@ -779,7 +795,13 @@ package body Parse is Res := Create_Iir (Iir_Kind_Attribute_Name); Set_Attribute_Identifier (Res, Current_Identifier); Set_Location (Res); - Set_Prefix (Res, Prefix); + if Get_Kind (Prefix) = Iir_Kind_Signature then + Set_Signature (Res, Prefix); + Set_Prefix (Res, Get_Prefix (Prefix)); + else + Set_Prefix (Res, Prefix); + end if; + -- accept the identifier. Scan.Scan; @@ -2761,12 +2783,14 @@ package body Parse is function Parse_Alias_Declaration return Iir is Res: Iir; - Loc : Location_Type; Ident : Name_Id; begin + Res := Create_Iir (Iir_Kind_Object_Alias_Declaration); + Set_Location (Res); + -- accept ALIAS. Scan.Scan; - Loc := Get_Token_Location; + case Current_Token is when Tok_Identifier => Ident := Current_Identifier; @@ -2779,31 +2803,18 @@ package body Parse is when others => Error_Msg_Parse ("alias designator expected"); end case; + Set_Identifier (Res, Ident); Scan.Scan; + if Current_Token = Tok_Colon then Scan.Scan; - Res := Create_Iir (Iir_Kind_Object_Alias_Declaration); Set_Type (Res, Parse_Subtype_Indication); - -- FIXME: nice message if token is ':=' ? - Expect (Tok_Is); - Scan.Scan; - Set_Name (Res, Parse_Name); - -- FIXME: emit error if token = '[' - elsif Current_Token = Tok_Is then - Res := Create_Iir (Iir_Kind_Non_Object_Alias_Declaration); - Scan.Scan; - Set_Name (Res, Parse_Name (Allow_Indexes => False)); - if Current_Token = Tok_Left_Bracket then - Set_Signature (Res, Parse_Signature); - end if; - else - Error_Msg_Parse ("'is' or ':' expected"); - Res := Create_Iir (Iir_Kind_Object_Alias_Declaration); - Eat_Tokens_Until_Semi_Colon; end if; - Set_Location (Res, Loc); - Set_Identifier (Res, Ident); + -- FIXME: nice message if token is ':=' ? + Expect (Tok_Is); + Scan.Scan; + Set_Name (Res, Parse_Name); return Res; end Parse_Alias_Declaration; @@ -2913,7 +2924,7 @@ package body Parse is if Current_Token = Tok_Left_Bracket then Name := Res; Res := Parse_Signature; - Set_Name (Res, Name); + Set_Prefix (Res, Name); end if; return Res; end Parse_Entity_Designator; @@ -3702,43 +3713,78 @@ package body Parse is -- factor ::= primary [ ** primary ] -- | ABS primary -- | NOT primary + -- | logical_operator primary [ VHDL08 9.1 ] + function Build_Unary_Factor (Primary : Iir; Op : Iir_Kind) return Iir is + Res : Iir; + begin + if Primary /= Null_Iir then + return Primary; + end if; + Res := Create_Iir (Op); + Set_Location (Res); + Scan.Scan; + Set_Operand (Res, Parse_Primary); + return Res; + end Build_Unary_Factor; + + function Build_Unary_Factor_08 (Primary : Iir; Op : Iir_Kind) return Iir is + begin + if Primary /= Null_Iir then + return Primary; + end if; + if Flags.Vhdl_Std < Vhdl_08 then + Error_Msg_Parse ("missing left operand of logical expression"); + -- Skip operator + Scan.Scan; + return Parse_Primary; + else + return Build_Unary_Factor (Primary, Op); + end if; + end Build_Unary_Factor_08; + function Parse_Factor (Primary : Iir := Null_Iir) return Iir_Expression is - Res, Tmp: Iir_Expression; + Res, Left: Iir_Expression; begin case Current_Token is when Tok_Abs => - if Primary /= Null_Iir then - return Primary; - end if; - Scan.Scan; - Res := Create_Iir (Iir_Kind_Absolute_Operator); - Set_Location (Res); - Set_Operand (Res, Parse_Primary); - return Res; + return Build_Unary_Factor (Primary, Iir_Kind_Absolute_Operator); when Tok_Not => - if Primary /= Null_Iir then - return Primary; - end if; - Res := Create_Iir (Iir_Kind_Not_Operator); - Set_Location (Res); - Scan.Scan; - Set_Operand (Res, Parse_Primary); - return Res; + return Build_Unary_Factor (Primary, Iir_Kind_Not_Operator); + + when Tok_And => + return Build_Unary_Factor_08 + (Primary, Iir_Kind_Reduction_And_Operator); + when Tok_Or => + return Build_Unary_Factor_08 + (Primary, Iir_Kind_Reduction_Or_Operator); + when Tok_Nand => + return Build_Unary_Factor_08 + (Primary, Iir_Kind_Reduction_Nand_Operator); + when Tok_Nor => + return Build_Unary_Factor_08 + (Primary, Iir_Kind_Reduction_Nor_Operator); + when Tok_Xor => + return Build_Unary_Factor_08 + (Primary, Iir_Kind_Reduction_Xor_Operator); + when Tok_Xnor => + return Build_Unary_Factor_08 + (Primary, Iir_Kind_Reduction_Xnor_Operator); + when others => if Primary /= Null_Iir then - Tmp := Primary; + Left := Primary; else - Tmp := Parse_Primary; + Left := Parse_Primary; end if; if Current_Token = Tok_Double_Star then Res := Create_Iir (Iir_Kind_Exponentiation_Operator); Set_Location (Res); Scan.Scan; - Set_Left (Res, Tmp); + Set_Left (Res, Left); Set_Right (Res, Parse_Primary); return Res; else - return Tmp; + return Left; end if; end case; end Parse_Factor; @@ -3897,6 +3943,19 @@ package body Parse is Res := Create_Iir (Iir_Kind_Greater_Than_Operator); when Tok_Greater_Equal => Res := Create_Iir (Iir_Kind_Greater_Than_Or_Equal_Operator); + when Tok_Match_Equal => + Res := Create_Iir (Iir_Kind_Match_Equality_Operator); + when Tok_Match_Not_Equal => + Res := Create_Iir (Iir_Kind_Match_Inequality_Operator); + when Tok_Match_Less => + Res := Create_Iir (Iir_Kind_Match_Less_Than_Operator); + when Tok_Match_Less_Equal => + Res := Create_Iir (Iir_Kind_Match_Less_Than_Or_Equal_Operator); + when Tok_Match_Greater => + Res := Create_Iir (Iir_Kind_Match_Greater_Than_Operator); + when Tok_Match_Greater_Equal => + Res := Create_Iir + (Iir_Kind_Match_Greater_Than_Or_Equal_Operator); when others => raise Program_Error; end case; @@ -3920,6 +3979,7 @@ package body Parse is -- -- [ §7.2 ] -- relational_operator ::= = | /= | < | <= | > | >= + -- | ?= | ?/= | ?< | ?<= | ?> | ?>= function Parse_Relation return Iir is Tmp: Iir; @@ -1393,7 +1393,44 @@ package body Scan is Pos := Pos + 1; Current_Token := Tok_Not; return; - when '$' | '?' | '`' + when '?' => + if Vhdl_Std < Vhdl_08 then + Error_Msg_Scan ("'?' can only be used in strings or comments"); + Pos := Pos + 1; + goto Again; + else + if Source (Pos + 1) = '<' then + if Source (Pos + 2) = '=' then + Current_Token := Tok_Match_Less_Equal; + Pos := Pos + 3; + else + Current_Token := Tok_Match_Less; + Pos := Pos + 2; + end if; + elsif Source (Pos + 1) = '>' then + if Source (Pos + 2) = '=' then + Current_Token := Tok_Match_Greater_Equal; + Pos := Pos + 3; + else + Current_Token := Tok_Match_Greater; + Pos := Pos + 2; + end if; + elsif Source (Pos + 1) = '=' then + Current_Token := Tok_Match_Equal; + Pos := Pos + 2; + elsif Source (Pos + 1) = '/' + and then Source (Pos + 2) = '=' + then + Current_Token := Tok_Match_Not_Equal; + Pos := Pos + 3; + else + Error_Msg_Scan ("unknown matching operator"); + Pos := Pos + 1; + goto Again; + end if; + end if; + return; + when '$' | '`' | Inverted_Exclamation .. Inverted_Question | Multiplication_Sign | Division_Sign => Error_Msg_Scan ("character """ & Source (Pos) @@ -18,6 +18,7 @@ with Ada.Unchecked_Conversion; with Errorout; use Errorout; with Std_Package; use Std_Package; +with Ieee.Std_Logic_1164; with Libraries; with Std_Names; with Sem_Scopes; use Sem_Scopes; @@ -1770,8 +1771,8 @@ package body Sem is -- Purity/wait/all-sensitized is unknown (recursion). Update_Pure_Unknown ); - function Update_And_Check_Pure_Wait (Subprg : Iir) - return Update_Pure_Status + + function Update_And_Check_Pure_Wait (Subprg : Iir) return Update_Pure_Status is procedure Error_Wait (Caller : Iir; Callee : Iir) is begin @@ -1880,9 +1881,10 @@ package body Sem is -- Second loop: recurse if a state is not known. if J = 1 and then - (Get_Purity_State (Callee) = Unknown - or else Get_Wait_State (Callee) = Unknown - or else Get_All_Sensitized_State (Callee) = Unknown) + ((Get_Kind (Callee) = Iir_Kind_Procedure_Declaration + and then Get_Purity_State (Callee) = Unknown) + or else Get_Wait_State (Callee) = Unknown + or else Get_All_Sensitized_State (Callee) = Unknown) then Res1 := Update_And_Check_Pure_Wait (Callee); if Res1 = Update_Pure_Missing then @@ -1962,7 +1964,8 @@ package body Sem is -- Keep in list. if Callee_Bod = Null_Iir or else - (Get_Purity_State (Callee) = Unknown + (Get_Kind (Callee) = Iir_Kind_Procedure_Declaration + and then Get_Purity_State (Callee) = Unknown and then Depth /= Iir_Depth_Impure) or else (Get_Wait_State (Callee) = Unknown @@ -2179,6 +2182,14 @@ package body Sem is Set_Visible_Flag (Unit, True); Xref_Decl (Decl); + -- Identify IEEE.Std_Logic_1164 for VHDL08. + if Get_Identifier (Decl) = Std_Names.Name_Std_Logic_1164 + and then (Get_Identifier (Get_Library (Get_Design_File (Unit))) + = Std_Names.Name_Ieee) + then + Ieee.Std_Logic_1164.Std_Logic_1164_Pkg := Decl; + end if; + -- LRM93 10.1 Declarative Region -- 4. A package declaration, together with the corresponding -- body (if any). diff --git a/sem_decls.adb b/sem_decls.adb index 3636491f9..2b04ab8ec 100644 --- a/sem_decls.adb +++ b/sem_decls.adb @@ -21,6 +21,7 @@ with Std_Names; with Tokens; with Flags; use Flags; with Std_Package; use Std_Package; +with Ieee.Std_Logic_1164; with Iir_Chains; with Evaluation; use Evaluation; with Name_Table; @@ -589,6 +590,18 @@ package body Sem_Decls is Add_Operation (Name, Def, Unary_Chain, Type_Definition); end Add_Unary; + procedure Add_Min_Max (Name : Name_Id; Def : Iir_Predefined_Functions) + is + Left, Right : Iir; + begin + Left := Create_Anonymous_Interface (Type_Definition); + Set_Identifier (Left, Name_L); + Right := Create_Anonymous_Interface (Type_Definition); + Set_Identifier (Right, Name_R); + Set_Chain (Left, Right); + Add_Operation (Name, Def, Left, Type_Definition); + end Add_Min_Max; + procedure Add_Shift_Operators is Inter_Chain : Iir_Constant_Interface_Declaration; @@ -640,6 +653,26 @@ package body Sem_Decls is Add_Relational (Name_Op_Less_Equal, Iir_Predefined_Enum_Less_Equal); + if Flags.Vhdl_Std >= Vhdl_08 then + Add_Min_Max (Name_Minimum, Iir_Predefined_Enum_Minimum); + Add_Min_Max (Name_Maximum, Iir_Predefined_Enum_Maximum); + + if Type_Definition = Ieee.Std_Logic_1164.Std_Ulogic_Type then + Add_Binary (Name_Op_Match_Equality, + Iir_Predefined_Std_Ulogic_Match_Equality); + Add_Binary (Name_Op_Match_Inequality, + Iir_Predefined_Std_Ulogic_Match_Inequality); + Add_Binary (Name_Op_Match_Less, + Iir_Predefined_Std_Ulogic_Match_Less); + Add_Binary (Name_Op_Match_Less_Equal, + Iir_Predefined_Std_Ulogic_Match_Less_Equal); + Add_Binary (Name_Op_Match_Greater, + Iir_Predefined_Std_Ulogic_Match_Greater); + Add_Binary (Name_Op_Match_Greater_Equal, + Iir_Predefined_Std_Ulogic_Match_Greater_Equal); + end if; + end if; + when Iir_Kind_Array_Type_Definition | Iir_Kind_Array_Subtype_Definition => declare @@ -704,7 +737,8 @@ package body Sem_Decls is and then String_Type_Definition /= Null_Iir and then Get_Kind (Get_Base_Type (Element_Type)) = Iir_Kind_Enumeration_Type_Definition - and then Get_Only_Characters_Flag (Element_Type) + and then Get_Only_Characters_Flag + (Get_Base_Type (Element_Type)) then Add_Operation (Name_To_String, Iir_Predefined_Array_To_String, @@ -814,6 +848,11 @@ package body Sem_Decls is Inter_Chain, Type_Definition); end; + if Vhdl_Std >= Vhdl_08 then + Add_Min_Max (Name_Minimum, Iir_Predefined_Integer_Minimum); + Add_Min_Max (Name_Maximum, Iir_Predefined_Integer_Maximum); + end if; + when Iir_Kind_Floating_Type_Definition => Add_Relational (Name_Op_Equality, Iir_Predefined_Floating_Equality); @@ -850,6 +889,11 @@ package body Sem_Decls is Inter_Chain, Type_Definition); end; + if Vhdl_Std >= Vhdl_08 then + Add_Min_Max (Name_Minimum, Iir_Predefined_Floating_Minimum); + Add_Min_Max (Name_Maximum, Iir_Predefined_Floating_Maximum); + end if; + when Iir_Kind_Physical_Type_Definition => Add_Relational (Name_Op_Equality, Iir_Predefined_Physical_Equality); @@ -920,6 +964,11 @@ package body Sem_Decls is Add_Unary (Name_Abs, Iir_Predefined_Physical_Absolute); + if Vhdl_Std >= Vhdl_08 then + Add_Min_Max (Name_Minimum, Iir_Predefined_Physical_Minimum); + Add_Min_Max (Name_Maximum, Iir_Predefined_Physical_Maximum); + end if; + when Iir_Kind_File_Type_Definition => Create_Implicit_File_Primitives (Decl, Type_Definition); @@ -953,6 +1002,20 @@ package body Sem_Decls is Add_Binary (Name_Xnor, Iir_Predefined_Bit_Xnor); end if; Add_Unary (Name_Not, Iir_Predefined_Bit_Not); + if Flags.Vhdl_Std >= Vhdl_08 then + Add_Binary (Name_Op_Match_Equality, + Iir_Predefined_Bit_Match_Equality); + Add_Binary (Name_Op_Match_Inequality, + Iir_Predefined_Bit_Match_Inequality); + Add_Binary (Name_Op_Match_Less, + Iir_Predefined_Bit_Match_Less); + Add_Binary (Name_Op_Match_Less_Equal, + Iir_Predefined_Bit_Match_Less_Equal); + Add_Binary (Name_Op_Match_Greater, + Iir_Predefined_Bit_Match_Greater); + Add_Binary (Name_Op_Match_Greater_Equal, + Iir_Predefined_Bit_Match_Greater_Equal); + end if; elsif Decl = Std_Package.Universal_Real_Type then declare Inter_Chain : Iir; @@ -1640,36 +1703,10 @@ package body Sem_Decls is procedure Sem_Object_Alias_Declaration (Alias: Iir_Object_Alias_Declaration) is N_Type: Iir; - N_Name: Iir; - Name : Iir; + N_Name: constant Iir := Get_Name (Alias); Name_Type : Iir; begin - Sem_Scopes.Add_Name (Alias); - Xref_Decl (Alias); - - Name := Get_Name (Alias); - Sem_Name (Name, False); - N_Name := Get_Named_Entity (Name); - if N_Name = Error_Mark then - return; - end if; - -- FIXME: overload list ? - - Name_Visible (Alias); - - case Get_Kind (N_Name) is - when Iir_Kinds_Object_Declaration - | Iir_Kind_Slice_Name - | Iir_Kind_Indexed_Name - | Iir_Kind_Selected_Name - | Iir_Kind_Selected_Element => - Set_Base_Name (Alias, Alias); -- Get_Base_Name (N_Name)); - Xref_Name (Name); - Set_Name (Alias, N_Name); - when others => - Error_Msg_Sem ("can only alias named object", Alias); - return; - end case; + Set_Base_Name (Alias, Alias); -- Get_Base_Name (N_Name)); -- LRM93 4.3.3.1 Object Aliases. -- 1. A signature may not appear in a declaration of an object alias. @@ -1690,6 +1727,7 @@ package body Sem_Decls is Set_Type (Alias, Name_Type); N_Type := Name_Type; else + -- FIXME: must be analyzed before calling Name_Visibility. N_Type := Sem_Subtype_Indication (N_Type); if N_Type /= Null_Iir then Set_Type (Alias, N_Type); @@ -1869,152 +1907,120 @@ package body Sem_Decls is (Alias : Iir_Non_Object_Alias_Declaration) is use Std_Names; - Name : Iir; - Sig : Iir_Signature; - N_Entity : Iir; + N_Entity : constant Iir := Get_Name (Alias); Id : Name_Id; begin - Name := Get_Name (Alias); - Sem_Name (Name, False); - N_Entity := Get_Named_Entity (Name); - if N_Entity = Error_Mark then - return; - end if; - Xref_Decl (Alias); - - Sig := Get_Signature (Alias); - if Is_Overload_List (N_Entity) then - if Sig = Null_Iir then - Error_Msg_Sem - ("signature required for alias of a subprogram", Alias); - return; - end if; - end if; - - if Sig /= Null_Iir then - N_Entity := Sem_Signature (N_Entity, Sig); - else - case Get_Kind (N_Entity) is - when Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => - -- LRM93 4.3.3.2 Non-Object Aliases - -- 2. A signature is required if the name denotes a subprogram - -- (including an operator) or enumeration literal. + case Get_Kind (N_Entity) is + when Iir_Kind_Function_Declaration + | Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Implicit_Procedure_Declaration => + -- LRM93 4.3.3.2 Non-Object Aliases + -- 2. A signature is required if the name denotes a subprogram + -- (including an operator) or enumeration literal. + if Get_Signature (Alias) = Null_Iir then Error_Msg_Sem ("signature required for subprogram", Alias); - return; - when Iir_Kind_Enumeration_Literal => + end if; + when Iir_Kind_Enumeration_Literal => + if Get_Signature (Alias) = Null_Iir then Error_Msg_Sem ("signature required for enumeration literal", Alias); - return; - when Iir_Kind_Type_Declaration => - declare - Def : Iir; - Last : Iir; - El : Iir; - Enum_List : Iir_Enumeration_Literal_List; - - procedure Add_Implicit_Alias (Decl : Iir) - is - N_Alias : Iir_Non_Object_Alias_Declaration; - begin - N_Alias := - Create_Iir (Iir_Kind_Non_Object_Alias_Declaration); - Location_Copy (N_Alias, Alias); - Set_Identifier (N_Alias, Get_Identifier (Decl)); - Set_Name (N_Alias, Decl); - - Add_Name (El, Get_Identifier (El), False); - Set_Visible_Flag (N_Alias, True); - - -- Append in the declaration chain. - Set_Chain (N_Alias, Get_Chain (Last)); - Set_Chain (Last, N_Alias); - Last := N_Alias; - end Add_Implicit_Alias; + end if; + when Iir_Kind_Type_Declaration => + declare + Def : Iir; + Last : Iir; + El : Iir; + Enum_List : Iir_Enumeration_Literal_List; + + procedure Add_Implicit_Alias (Decl : Iir) + is + N_Alias : constant Iir_Non_Object_Alias_Declaration := + Create_Iir (Iir_Kind_Non_Object_Alias_Declaration); begin - Def := Get_Type (N_Entity); - Last := Alias; - if Get_Kind (Def) = Iir_Kind_Enumeration_Type_Definition - then - -- LRM93 4.3.3.2 Non-Object Aliases - -- 3. If the name denotes an enumeration type, then one - -- implicit alias declaration for each of the - -- literals of the type immediatly follows the alias - -- declaration for the enumeration type; [...] - Enum_List := Get_Enumeration_Literal_List (Def); - for I in Natural loop - El := Get_Nth_Element (Enum_List, I); - exit when El = Null_Iir; - -- LRM93 4.3.3.2 Non-Object Aliases - -- [...] each such implicit declaration has, as - -- its alias designator, the simple name or - -- character literal of the literal, and has, - -- as its name, a name constructed - -- by taking the name of the alias for the - -- enumeration type and substituting the simple - -- name or character literal being aliased for - -- the simple name of the type. - -- Each implicit alias has a signature that - -- matches the parameter and result type profile - -- of the literal being aliased. - Add_Implicit_Alias (El); - end loop; - end if; - - -- LRM93 4.3.3.2 Non-Object Aliases - -- 4. Alternatively, if the name denotes a physical type - -- [...] - -- GHDL: this is not possible, since a physical type is - -- anonymous (LRM93 is buggy on this point). - if Get_Kind (Def) = Iir_Kind_Physical_Type_Definition then - raise Internal_Error; - end if; - + Location_Copy (N_Alias, Alias); + Set_Identifier (N_Alias, Get_Identifier (Decl)); + Set_Name (N_Alias, Decl); + + Add_Name (El, Get_Identifier (El), False); + Set_Visible_Flag (N_Alias, True); + + -- Append in the declaration chain. + Set_Chain (N_Alias, Get_Chain (Last)); + Set_Chain (Last, N_Alias); + Last := N_Alias; + end Add_Implicit_Alias; + begin + Def := Get_Type (N_Entity); + Last := Alias; + if Get_Kind (Def) = Iir_Kind_Enumeration_Type_Definition then -- LRM93 4.3.3.2 Non-Object Aliases - -- 5. Finally, if the name denotes a type, then implicit - -- alias declarations for each predefined operator - -- for the type immediatly follow the explicit alias - -- declaration for the type, and if present, any - -- implicit alias declarations for literals or units - -- of the type. - -- Each implicit alias has a signature that matches the - -- parameter and result type profule of the implicit - -- operator being aliased. - El := Get_Chain (N_Entity); - while El /= Null_Iir loop - case Get_Kind (El) is - when Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => - exit when Get_Type_Reference (El) /= N_Entity; - when others => - exit; - end case; + -- 3. If the name denotes an enumeration type, then one + -- implicit alias declaration for each of the + -- literals of the type immediatly follows the alias + -- declaration for the enumeration type; [...] + Enum_List := Get_Enumeration_Literal_List (Def); + for I in Natural loop + El := Get_Nth_Element (Enum_List, I); + exit when El = Null_Iir; + -- LRM93 4.3.3.2 Non-Object Aliases + -- [...] each such implicit declaration has, as + -- its alias designator, the simple name or + -- character literal of the literal, and has, + -- as its name, a name constructed + -- by taking the name of the alias for the + -- enumeration type and substituting the simple + -- name or character literal being aliased for + -- the simple name of the type. + -- Each implicit alias has a signature that + -- matches the parameter and result type profile + -- of the literal being aliased. Add_Implicit_Alias (El); - El := Get_Chain (El); end loop; - end; - when Iir_Kinds_Object_Declaration => - Error_Msg_Sem - ("non-object alias cannot denotes an object", Alias); - -- Do not return and add the name to avoid an error storm. - when Iir_Kind_Subtype_Declaration - | Iir_Kind_Attribute_Declaration => - null; - when Iir_Kind_Terminal_Declaration => - null; - when others => - Error_Kind ("sem_non_object_alias_declaration", N_Entity); - end case; - end if; - if N_Entity = Null_Iir then - return; - end if; - Set_Named_Entity (Name, N_Entity); - Xref_Name (Name); + end if; - Set_Name (Alias, N_Entity); + -- LRM93 4.3.3.2 Non-Object Aliases + -- 4. Alternatively, if the name denotes a physical type + -- [...] + -- GHDL: this is not possible, since a physical type is + -- anonymous (LRM93 is buggy on this point). + if Get_Kind (Def) = Iir_Kind_Physical_Type_Definition then + raise Internal_Error; + end if; + + -- LRM93 4.3.3.2 Non-Object Aliases + -- 5. Finally, if the name denotes a type, then implicit + -- alias declarations for each predefined operator + -- for the type immediatly follow the explicit alias + -- declaration for the type, and if present, any + -- implicit alias declarations for literals or units + -- of the type. + -- Each implicit alias has a signature that matches the + -- parameter and result type profule of the implicit + -- operator being aliased. + El := Get_Chain (N_Entity); + while El /= Null_Iir loop + case Get_Kind (El) is + when Iir_Kind_Implicit_Function_Declaration + | Iir_Kind_Implicit_Procedure_Declaration => + exit when Get_Type_Reference (El) /= N_Entity; + when others => + exit; + end case; + Add_Implicit_Alias (El); + El := Get_Chain (El); + end loop; + end; + when Iir_Kinds_Object_Declaration => + raise Internal_Error; + when Iir_Kind_Subtype_Declaration + | Iir_Kind_Attribute_Declaration => + null; + when Iir_Kind_Terminal_Declaration => + null; + when others => + Error_Kind ("sem_non_object_alias_declaration", N_Entity); + end case; Id := Get_Identifier (Alias); @@ -2047,10 +2053,84 @@ package body Sem_Decls is when others => null; end case; - Add_Name (Alias); - Set_Visible_Flag (Alias, True); end Sem_Non_Object_Alias_Declaration; + function Sem_Alias_Declaration (Alias : Iir) return Iir + is + use Std_Names; + Name : Iir; + Sig : Iir_Signature; + N_Entity : Iir; + Res : Iir; + begin + Xref_Decl (Alias); + + Name := Get_Name (Alias); + if Get_Kind (Name) = Iir_Kind_Signature then + Sig := Name; + Name := Get_Prefix (Name); + else + Sig := Null_Iir; + end if; + + Sem_Name (Name, False); + N_Entity := Get_Named_Entity (Name); + if N_Entity = Error_Mark then + return Alias; + end if; + + if Is_Overload_List (N_Entity) then + if Sig = Null_Iir then + Error_Msg_Sem + ("signature required for alias of a subprogram", Alias); + return Alias; + end if; + end if; + + if Sig /= Null_Iir then + N_Entity := Sem_Signature (N_Entity, Sig); + end if; + if N_Entity = Null_Iir then + return Alias; + end if; + + Set_Named_Entity (Name, N_Entity); + Xref_Name (Name); + + if Is_Object_Name (N_Entity) then + Sem_Scopes.Add_Name (Alias); + Name_Visible (Alias); + + if Sig /= Null_Iir then + Error_Msg_Sem + ("signature not allowed for object alias", Sig); + end if; + Set_Name (Alias, N_Entity); + Sem_Object_Alias_Declaration (Alias); + return Alias; + else + if Get_Type (Alias) /= Null_Iir then + Error_Msg_Sem + ("subtype indication not allowed for non-object alias", Alias); + end if; + Res := Create_Iir (Iir_Kind_Non_Object_Alias_Declaration); + Location_Copy (Res, Alias); + Set_Parent (Res, Get_Parent (Alias)); + Set_Chain (Res, Get_Chain (Alias)); + Set_Identifier (Res, Get_Identifier (Alias)); + Set_Name (Res, N_Entity); + Set_Signature (Res, Sig); + + Sem_Scopes.Add_Name (Res); + Name_Visible (Res); + + Free_Iir (Alias); + + Sem_Non_Object_Alias_Declaration (Res); + return Res; + end if; + end Sem_Alias_Declaration; + procedure Sem_Group_Template_Declaration (Decl : Iir_Group_Template_Declaration) is @@ -2349,20 +2429,29 @@ package body Sem_Decls is | Iir_Kind_Implicit_Procedure_Declaration => Sem_Scopes.Add_Name (Decl); Name_Visible (Decl); - when Iir_Kind_Object_Alias_Declaration => - Sem_Object_Alias_Declaration (Decl); when Iir_Kind_Non_Object_Alias_Declaration => - Last_Decl := Decl; - Decl := Get_Chain (Decl); - Sem_Non_Object_Alias_Declaration (Last_Decl); - if Attr_Spec_Chain /= Null_Iir then - while Last_Decl /= Decl loop - Check_Post_Attribute_Specification - (Attr_Spec_Chain, Last_Decl); - Last_Decl := Get_Chain (Last_Decl); - end loop; - end if; - goto Again; + -- Added by Sem_Alias_Declaration. Need to check that no + -- existing attribute specification apply to them. + null; + when Iir_Kind_Object_Alias_Declaration => + declare + Res : Iir; + begin + Res := Sem_Alias_Declaration (Decl); + if Res /= Decl then + -- Replace DECL with RES. + if Last_Decl = Null_Iir then + Set_Declaration_Chain (Parent, Res); + else + Set_Chain (Last_Decl, Res); + end if; + Decl := Res; + + -- An alias may add new alias declarations. Do not skip + -- them: check that no existing attribute specifications + -- apply to them. + end if; + end; when Iir_Kind_File_Declaration => Sem_File_Declaration (Decl); when Iir_Kind_Use_Clause => diff --git a/sem_expr.adb b/sem_expr.adb index 4ee643665..a9e592b86 100644 --- a/sem_expr.adb +++ b/sem_expr.adb @@ -4116,4 +4116,54 @@ package body Sem_Expr is return Sem_Expression_Ov (Expr1, Res); end Sem_Case_Expression; + function Sem_Condition (Cond : Iir) return Iir + is + Res : Iir; + Op : Iir; + begin + if Vhdl_Std < Vhdl_08 then + Res := Sem_Expression (Cond, Boolean_Type_Definition); + + Check_Read (Res); + return Res; + else + -- LRM08 9.2.9 + -- If, without overload resolution (see 12.5), the expression is + -- of type BOOLEAN defined in package STANDARD, or if, assuming a + -- rule requiring the expression to be of type BOOLEAN defined in + -- package STANDARD, overload resolution can determine at least one + -- interpretation of each constituent of the innermost complete + -- context including the expression, then the condition operator is + -- not applied. + + -- GHDL: what does the second alternative mean ? Any example ? + + Res := Sem_Expression_Ov (Cond, Null_Iir); + + if Res = Null_Iir then + return Res; + end if; + + if not Is_Overloaded (Res) + and then Get_Type (Res) = Boolean_Type_Definition + then + Check_Read (Res); + return Res; + end if; + + -- LRM08 9.2.9 + -- Otherwise, the condition operator is implicitely applied, and the + -- type of the expresion with the implicit application shall be + -- BOOLEAN defined in package STANDARD. + + Op := Create_Iir (Iir_Kind_Condition_Operator); + Location_Copy (Op, Res); + Set_Operand (Op, Res); + + Res := Sem_Operator (Op, Boolean_Type_Definition, 1); + Check_Read (Res); + return Res; + end if; + end Sem_Condition; + end Sem_Expr; diff --git a/sem_expr.ads b/sem_expr.ads index 2fa594b7f..e209afdfa 100644 --- a/sem_expr.ads +++ b/sem_expr.ads @@ -63,6 +63,12 @@ package Sem_Expr is -- (Handle specific overloading rules). function Sem_Case_Expression (Expr : Iir) return Iir; + -- Sem COND as a condition. + -- In VHDL08, this follows 9.2.9 Condition operator. + -- In VHDL87 and 93, type of COND must be a boolean. + -- A check is made that COND can be read. + function Sem_Condition (Cond : Iir) return Iir; + -- Check EXPR can be read. procedure Check_Read (Expr : Iir); diff --git a/sem_names.adb b/sem_names.adb index 51232a05e..89e8dfd86 100644 --- a/sem_names.adb +++ b/sem_names.adb @@ -1981,7 +1981,7 @@ package body Sem_Names is end; if Res = Null_Iir then Error_Msg_Sem - ("No overloaded subprogram found matching " + ("no overloaded function found matching " & Disp_Node (Prefix_Name), Name); end if; when Iir_Kinds_Function_Declaration => diff --git a/sem_scopes.adb b/sem_scopes.adb index 7737ed881..3acb6b141 100644 --- a/sem_scopes.adb +++ b/sem_scopes.adb @@ -832,13 +832,17 @@ package body Sem_Scopes is Inter : Name_Interpretation_Type; begin Inter := Get_Interpretation (Id); - if Get_Declaration (Inter) /= Old then - raise Internal_Error; - end if; + loop + exit when Get_Declaration (Inter) = Old; + Inter := Get_Next_Interpretation (Inter); + if not Valid_Interpretation (Inter) then + raise Internal_Error; + end if; + end loop; + Interpretations.Table (Inter).Decl := Decl; if Get_Next_Interpretation (Inter) /= No_Name_Interpretation then raise Internal_Error; end if; - Interpretations.Table (Inter).Decl := Decl; end Replace_Name; procedure Name_Visible (Ident : Name_Id; Decl : Iir) diff --git a/sem_scopes.ads b/sem_scopes.ads index c686ff2bd..b8f7664de 100644 --- a/sem_scopes.ads +++ b/sem_scopes.ads @@ -59,7 +59,9 @@ package Sem_Scopes is -- Replace the interpretation OLD of ID by DECL. -- ID must have a uniq interpretation OLD (ie, it must not be overloaded). -- The interpretation must have been done in the current scope. - -- This is necessary when a concurrent_procedure_call_statement becomes + -- + -- This procedure is used when the meaning of a name is changed due to its + -- analysis, eg: when a concurrent_procedure_call_statement becomes -- a component_instantiation_statement. procedure Replace_Name (Id: Name_Id; Old : Iir; Decl: Iir); diff --git a/sem_specs.adb b/sem_specs.adb index 3117481ed..885a41abc 100644 --- a/sem_specs.adb +++ b/sem_specs.adb @@ -586,7 +586,7 @@ package body Sem_Specs is Name : Iir; begin List := Create_Iir_List; - Inter := Get_Interpretation (Get_Identifier (Get_Name (Sig))); + Inter := Get_Interpretation (Get_Identifier (Get_Prefix (Sig))); while Valid_Interpretation (Inter) loop exit when not Is_In_Current_Declarative_Region (Inter); if not Is_Potentially_Visible (Inter) then @@ -616,7 +616,7 @@ package body Sem_Specs is if Name = Null_Iir then return; end if; - Attribute_A_Decl (Name, Attr, Get_Name (Sig), True, True); + Attribute_A_Decl (Name, Attr, Get_Prefix (Sig), True, True); end Sem_Signature_Entity_Designator; procedure Sem_Attribute_Specification diff --git a/sem_stmts.adb b/sem_stmts.adb index 373ea7d68..4ae668acc 100644 --- a/sem_stmts.adb +++ b/sem_stmts.adb @@ -775,8 +775,7 @@ package body Sem_Stmts is Expr : Iir; begin Expr := Get_Assertion_Condition (Stmt); - Expr := Sem_Expression (Expr, Boolean_Type_Definition); - Check_Read (Expr); + Expr := Sem_Condition (Expr); Expr := Eval_Expr_If_Static (Expr); Set_Assertion_Condition (Stmt, Expr); @@ -1050,8 +1049,7 @@ package body Sem_Stmts is end if; Expr := Get_Condition_Clause (Stmt); if Expr /= Null_Iir then - Expr := Sem_Expression (Expr, Boolean_Type_Definition); - Check_Read (Expr); + Expr := Sem_Condition (Expr); Set_Condition_Clause (Stmt, Expr); end if; Expr := Get_Timeout_Clause (Stmt); @@ -1078,8 +1076,7 @@ package body Sem_Stmts is begin Cond := Get_Condition (Stmt); if Cond /= Null_Iir then - Cond := Sem_Expression (Cond, Boolean_Type_Definition); - Check_Read (Cond); + Cond := Sem_Condition (Cond); Set_Condition (Stmt, Cond); end if; Label := Get_Loop (Stmt); @@ -1137,8 +1134,7 @@ package body Sem_Stmts is while Clause /= Null_Iir loop Cond := Get_Condition (Clause); if Cond /= Null_Iir then - Cond := Sem_Expression (Cond, Boolean_Type_Definition); - Check_Read (Cond); + Cond := Sem_Condition (Cond); Set_Condition (Clause, Cond); end if; Sem_Sequential_Statements_Internal @@ -1171,8 +1167,7 @@ package body Sem_Stmts is begin Cond := Get_Condition (Stmt); if Cond /= Null_Iir then - Cond := Sem_Expression (Cond, Boolean_Type_Definition); - Check_Read (Cond); + Cond := Sem_Condition (Cond); Set_Condition (Stmt, Cond); end if; Sem_Sequential_Statements_Internal @@ -1430,9 +1425,8 @@ package body Sem_Stmts is Set_Expr_Staticness (Guard, None); Set_Name_Staticness (Guard, Locally); Expr := Get_Guard_Expression (Guard); - Expr := Sem_Expression (Expr, Boolean_Type_Definition); + Expr := Sem_Condition (Expr); if Expr /= Null_Iir then - Check_Read (Expr); Set_Guard_Expression (Guard, Expr); end if; @@ -1480,8 +1474,7 @@ package body Sem_Stmts is Error_Msg_Sem ("range must be a static discrete range", Stmt); end if; else - Scheme := Sem_Expression (Scheme, Boolean_Type_Definition); - Check_Read (Scheme); + Scheme := Sem_Condition (Scheme); -- LRM93 §9.7 -- the condition in a generation scheme of the second form must be -- a static expression. @@ -1609,9 +1602,8 @@ package body Sem_Stmts is Sem_Check_Waveform_Chain (Stmt, Wf_Chain); Expr := Get_Condition (Cond_Wf); if Expr /= Null_Iir then - Expr := Sem_Expression (Expr, Boolean_Type_Definition); + Expr := Sem_Condition (Expr); if Expr /= Null_Iir then - Check_Read (Expr); Set_Condition (Cond_Wf, Expr); end if; end if; diff --git a/sem_types.adb b/sem_types.adb index 591fa4875..d7cd35190 100644 --- a/sem_types.adb +++ b/sem_types.adb @@ -29,6 +29,7 @@ with Name_Table; with Std_Names; with Iirs_Utils; use Iirs_Utils; with Std_Package; use Std_Package; +with Ieee.Std_Logic_1164; with Xrefs; use Xrefs; package body Sem_Types is @@ -757,6 +758,15 @@ package body Sem_Types is Set_Only_Characters_Flag (Def, Only_Characters); end; Set_Resolved_Flag (Def, False); + + -- Identifier IEEE.Std_Logic_1164.Std_Ulogic. + if Get_Identifier (Decl) = Std_Names.Name_Std_Ulogic + and then + Get_Parent (Decl) = Ieee.Std_Logic_1164.Std_Logic_1164_Pkg + then + Ieee.Std_Logic_1164.Std_Ulogic_Type := Def; + end if; + return Def; when Iir_Kind_Range_Expression => diff --git a/std_names.adb b/std_names.adb index 82f883530..083e4ef9f 100644 --- a/std_names.adb +++ b/std_names.adb @@ -52,6 +52,12 @@ package body Std_Names is Def ("**", Name_Op_Exp); Def ("&", Name_Op_Concatenation); Def ("??", Name_Op_Condition); + Def ("?=", Name_Op_Match_Equality); + Def ("?/=", Name_Op_Match_Inequality); + Def ("?<", Name_Op_Match_Less); + Def ("?<=", Name_Op_Match_Less_Equal); + Def ("?>", Name_Op_Match_Greater); + Def ("?>=", Name_Op_Match_Greater_Equal); -- Create Attributes. Def ("base", Name_Base); @@ -143,6 +149,18 @@ package body Std_Names is Def ("name_error", Name_Name_Error); Def ("mode_error", Name_Mode_Error); Def ("foreign", Name_Foreign); + + Def ("boolean_vector", Name_Boolean_Vector); + Def ("to_bstring", Name_To_Bstring); + Def ("to_binary_string", Name_To_Binary_String); + Def ("to_ostring", Name_To_Ostring); + Def ("to_octal_string", Name_To_Octal_String); + Def ("to_hstring", Name_To_Hstring); + Def ("to_hex_string", Name_To_Hex_String); + Def ("integer_vector", Name_Integer_Vector); + Def ("real_vector", Name_Real_Vector); + Def ("time_vector", Name_Time_Vector); + Def ("domain_type", Name_Domain_Type); Def ("quiescent_domain", Name_Quiescent_Domain); Def ("time_domain", Name_Time_Domain); @@ -229,6 +247,9 @@ package body Std_Names is Def ("endfile", Name_Endfile); Def ("p", Name_P); Def ("f", Name_F); + Def ("l", Name_L); + Def ("r", Name_R); + Def ("s", Name_S); Def ("external_name", Name_External_Name); Def ("open_kind", Name_Open_Kind); Def ("status", Name_Status); @@ -238,6 +259,8 @@ package body Std_Names is Def ("work", Name_Work); Def ("text", Name_Text); Def ("to_string", Name_To_String); + Def ("minimum", Name_Minimum); + Def ("maximum", Name_Maximum); Def ("untruncated_text_read", Name_Untruncated_Text_Read); Def ("ieee", Name_Ieee); diff --git a/std_names.ads b/std_names.ads index e6ba625bf..11761f207 100644 --- a/std_names.ads +++ b/std_names.ads @@ -196,21 +196,27 @@ package Std_Names is subtype Name_Id_Keywords is Name_Id range Name_First_Keyword .. Name_Last_Keyword; - Name_First_Operator : constant Name_Id := Name_Last_Keyword + 1; - Name_Op_Equality : constant Name_Id := Name_First_Operator + 000; - Name_Op_Inequality : constant Name_Id := Name_First_Operator + 001; - Name_Op_Less : constant Name_Id := Name_First_Operator + 002; - Name_Op_Less_Equal : constant Name_Id := Name_First_Operator + 003; - Name_Op_Greater : constant Name_Id := Name_First_Operator + 004; + Name_First_Operator : constant Name_Id := Name_Last_Keyword + 1; + Name_Op_Equality : constant Name_Id := Name_First_Operator + 000; + Name_Op_Inequality : constant Name_Id := Name_First_Operator + 001; + Name_Op_Less : constant Name_Id := Name_First_Operator + 002; + Name_Op_Less_Equal : constant Name_Id := Name_First_Operator + 003; + Name_Op_Greater : constant Name_Id := Name_First_Operator + 004; Name_Op_Greater_Equal : constant Name_Id := Name_First_Operator + 5; - Name_Op_Plus : constant Name_Id := Name_First_Operator + 006; - Name_Op_Minus : constant Name_Id := Name_First_Operator + 007; - Name_Op_Mul : constant Name_Id := Name_First_Operator + 008; - Name_Op_Div : constant Name_Id := Name_First_Operator + 009; - Name_Op_Exp : constant Name_Id := Name_First_Operator + 010; + Name_Op_Plus : constant Name_Id := Name_First_Operator + 006; + Name_Op_Minus : constant Name_Id := Name_First_Operator + 007; + Name_Op_Mul : constant Name_Id := Name_First_Operator + 008; + Name_Op_Div : constant Name_Id := Name_First_Operator + 009; + Name_Op_Exp : constant Name_Id := Name_First_Operator + 010; Name_Op_Concatenation : constant Name_Id := Name_First_Operator + 011; - Name_Op_Condition : constant Name_Id := Name_First_Operator + 012; - Name_Last_Operator : constant Name_Id := Name_Op_Condition; + Name_Op_Condition : constant Name_Id := Name_First_Operator + 012; + Name_Op_Match_Equality : constant Name_Id := Name_First_Operator + 013; + Name_Op_Match_Inequality : constant Name_Id := Name_First_Operator + 014; + Name_Op_Match_Less : constant Name_Id := Name_First_Operator + 015; + Name_Op_Match_Less_Equal : constant Name_Id := Name_First_Operator + 016; + Name_Op_Match_Greater : constant Name_Id := Name_First_Operator + 017; + Name_Op_Match_Greater_Equal : constant Name_Id := Name_First_Operator + 018; + Name_Last_Operator : constant Name_Id := Name_Op_Match_Greater_Equal; subtype Name_Relational_Operators is Name_Id range Name_Op_Equality .. Name_Op_Greater_Equal; @@ -331,16 +337,27 @@ package Std_Names is Name_Mode_Error : constant Name_Id := Name_First_Standard + 041; Name_Foreign : constant Name_Id := Name_First_Standard + 042; + -- Added by VHDL 08 + Name_Boolean_Vector : constant Name_Id := Name_First_Standard + 043; + Name_To_Bstring : constant Name_Id := Name_First_Standard + 044; + Name_To_Binary_String : constant Name_Id := Name_First_Standard + 045; + Name_To_Ostring : constant Name_Id := Name_First_Standard + 046; + Name_To_Octal_String : constant Name_Id := Name_First_Standard + 047; + Name_To_Hstring : constant Name_Id := Name_First_Standard + 048; + Name_To_Hex_String : constant Name_Id := Name_First_Standard + 049; + Name_Integer_Vector : constant Name_Id := Name_First_Standard + 050; + Name_Real_Vector : constant Name_Id := Name_First_Standard + 051; + Name_Time_Vector : constant Name_Id := Name_First_Standard + 052; + -- Added by AMS vhdl. - Name_Domain_Type : constant Name_Id := Name_First_Standard + 043; - Name_Quiescent_Domain : constant Name_Id := Name_First_Standard + 044; - Name_Time_Domain : constant Name_Id := Name_First_Standard + 045; - Name_Frequency_Domain : constant Name_Id := Name_First_Standard + 046; - Name_Domain : constant Name_Id := Name_First_Standard + 047; - Name_Frequency : constant Name_Id := Name_First_Standard + 048; - Name_Real_Vector : constant Name_Id := Name_First_Standard + 049; + Name_Domain_Type : constant Name_Id := Name_First_Standard + 053; + Name_Quiescent_Domain : constant Name_Id := Name_First_Standard + 054; + Name_Time_Domain : constant Name_Id := Name_First_Standard + 055; + Name_Frequency_Domain : constant Name_Id := Name_First_Standard + 056; + Name_Domain : constant Name_Id := Name_First_Standard + 057; + Name_Frequency : constant Name_Id := Name_First_Standard + 058; - Name_Last_Standard : constant Name_Id := Name_Real_Vector; + Name_Last_Standard : constant Name_Id := Name_Frequency; Name_First_Charname : constant Name_Id := Name_Last_Standard + 1; Name_Nul : constant Name_Id := Name_First_Charname + 00; @@ -423,16 +440,21 @@ package Std_Names is Name_Endfile : constant Name_Id := Name_First_Misc + 007; Name_P : constant Name_Id := Name_First_Misc + 008; Name_F : constant Name_Id := Name_First_Misc + 009; - Name_External_Name : constant Name_Id := Name_First_Misc + 010; - Name_Open_Kind : constant Name_Id := Name_First_Misc + 011; - Name_Status : constant Name_Id := Name_First_Misc + 012; - Name_First : constant Name_Id := Name_First_Misc + 013; - Name_Last : constant Name_Id := Name_First_Misc + 014; - Name_Textio : constant Name_Id := Name_First_Misc + 015; - Name_Work : constant Name_Id := Name_First_Misc + 016; - Name_Text : constant Name_Id := Name_First_Misc + 017; - Name_To_String : constant Name_Id := Name_First_Misc + 018; - Name_Untruncated_Text_Read : constant Name_Id := Name_First_Misc + 019; + Name_L : constant Name_Id := Name_First_Misc + 010; + Name_R : constant Name_Id := Name_First_Misc + 011; + Name_S : constant Name_Id := Name_First_Misc + 012; + Name_External_Name : constant Name_Id := Name_First_Misc + 013; + Name_Open_Kind : constant Name_Id := Name_First_Misc + 014; + Name_Status : constant Name_Id := Name_First_Misc + 015; + Name_First : constant Name_Id := Name_First_Misc + 016; + Name_Last : constant Name_Id := Name_First_Misc + 017; + Name_Textio : constant Name_Id := Name_First_Misc + 018; + Name_Work : constant Name_Id := Name_First_Misc + 019; + Name_Text : constant Name_Id := Name_First_Misc + 020; + Name_To_String : constant Name_Id := Name_First_Misc + 021; + Name_Minimum : constant Name_Id := Name_First_Misc + 022; + Name_Maximum : constant Name_Id := Name_First_Misc + 023; + Name_Untruncated_Text_Read : constant Name_Id := Name_First_Misc + 024; Name_Last_Misc : constant Name_Id := Name_Untruncated_Text_Read; Name_First_Ieee : constant Name_Id := Name_Last_Misc + 1; diff --git a/std_package.adb b/std_package.adb index 6d090fdf0..a0160cb1b 100644 --- a/std_package.adb +++ b/std_package.adb @@ -233,6 +233,81 @@ package body Std_Package is Set_Subtype_Definition (Type_Decl, Subtype_Definition); end Create_Integer_Subtype; + -- Create an array of EL_TYPE, indexed by Natural. + procedure Create_Array_Type + (Def : out Iir; Decl : out Iir; El_Type : Iir; Name : Name_Id) + is + Index_List : Iir_List; + begin + Def := Create_Std_Iir (Iir_Kind_Array_Type_Definition); + Set_Base_Type (Def, Def); + Index_List := Create_Iir_List; + Set_Index_Subtype_List (Def, Index_List); + Append_Element (Index_List, Natural_Subtype_Definition); + Set_Element_Subtype (Def, El_Type); + Set_Type_Staticness (Def, None); + Set_Signal_Type_Flag (Def, True); + Set_Has_Signal_Flag (Def, not Flags.Flag_Whole_Analyze); + + Decl := Create_Std_Decl (Iir_Kind_Type_Declaration); + Set_Std_Identifier (Decl, Name); + Set_Type (Decl, Def); + Add_Decl (Decl); + Set_Type_Declarator (Def, Decl); + + Add_Implicit_Operations (Decl); + end Create_Array_Type; + + -- Create: + -- function TO_STRING (VALUE: inter_type) return STRING; + procedure Create_To_String (Inter_Type : Iir) + is + Decl : Iir_Implicit_Function_Declaration; + Inter : Iir_Constant_Interface_Declaration; + begin + Decl := Create_Std_Decl (Iir_Kind_Implicit_Function_Declaration); + Set_Std_Identifier (Decl, Std_Names.Name_To_String); + Set_Return_Type (Decl, String_Type_Definition); + Set_Pure_Flag (Decl, True); + -- FIXME!!! + Set_Implicit_Definition (Decl, Iir_Predefined_Now_Function); + + Inter := Create_Iir (Iir_Kind_Constant_Interface_Declaration); + Set_Identifier (Inter, Std_Names.Name_Value); + Set_Type (Inter, Inter_Type); + Set_Mode (Inter, Iir_In_Mode); + Set_Base_Name (Inter, Inter); + Set_Interface_Declaration_Chain (Decl, Inter); + + Sem.Compute_Subprogram_Hash (Decl); + Add_Decl (Decl); + end Create_To_String; + + -- Create: + -- function NAME (signal S : I inter_type) return BOOLEAN; + procedure Create_Edge_Function + (Name : Name_Id; Func : Iir_Predefined_Functions; Inter_Type : Iir) + is + Decl : Iir_Implicit_Function_Declaration; + Inter : Iir_Constant_Interface_Declaration; + begin + Decl := Create_Std_Decl (Iir_Kind_Implicit_Function_Declaration); + Set_Std_Identifier (Decl, Name); + Set_Return_Type (Decl, Boolean_Type_Definition); + Set_Pure_Flag (Decl, True); + Set_Implicit_Definition (Decl, Func); + + Inter := Create_Iir (Iir_Kind_Signal_Interface_Declaration); + Set_Identifier (Inter, Std_Names.Name_S); + Set_Type (Inter, Inter_Type); + Set_Mode (Inter, Iir_In_Mode); + Set_Base_Name (Inter, Inter); + Set_Interface_Declaration_Chain (Decl, Inter); + + Sem.Compute_Subprogram_Hash (Decl); + Add_Decl (Decl); + end Create_Edge_Function; + begin Std_Standard_File := Create_Std_Iir (Iir_Kind_Design_File); Set_Parent (Std_Standard_File, Parent); @@ -298,6 +373,15 @@ package body Std_Package is Add_Implicit_Operations (Boolean_Type); end; + if Vhdl_Std >= Vhdl_08 then + Create_Edge_Function + (Std_Names.Name_Rising_Edge, Iir_Predefined_Boolean_Rising_Edge, + Boolean_Type_Definition); + Create_Edge_Function + (Std_Names.Name_Falling_Edge, Iir_Predefined_Boolean_Falling_Edge, + Boolean_Type_Definition); + end if; + -- bit. begin -- ('0', '1') @@ -328,6 +412,15 @@ package body Std_Package is Add_Implicit_Operations (Bit_Type); end; + if Vhdl_Std >= Vhdl_08 then + Create_Edge_Function + (Std_Names.Name_Rising_Edge, Iir_Predefined_Bit_Rising_Edge, + Bit_Type_Definition); + Create_Edge_Function + (Std_Names.Name_Falling_Edge, Iir_Predefined_Bit_Falling_Edge, + Bit_Type_Definition); + end if; + -- characters. declare El: Iir; @@ -649,28 +742,16 @@ package body Std_Package is -- bit_vector type. -- type bit_vector is array (natural range <>) of bit; - begin - Bit_Vector_Type_Definition := - Create_Std_Iir (Iir_Kind_Array_Type_Definition); - Set_Base_Type (Bit_Vector_Type_Definition, - Bit_Vector_Type_Definition); - Set_Index_Subtype_List (Bit_Vector_Type_Definition, Create_Iir_List); - Append_Element (Get_Index_Subtype_List (Bit_Vector_Type_Definition), - Natural_Subtype_Definition); - Set_Element_Subtype (Bit_Vector_Type_Definition, Bit_Type_Definition); - Set_Type_Staticness (Bit_Vector_Type_Definition, None); - Set_Signal_Type_Flag (Bit_Vector_Type_Definition, True); - Set_Has_Signal_Flag (Bit_Vector_Type_Definition, - not Flags.Flag_Whole_Analyze); - - Bit_Vector_Type := Create_Std_Decl (Iir_Kind_Type_Declaration); - Set_Std_Identifier (Bit_Vector_Type, Name_Bit_Vector); - Set_Type (Bit_Vector_Type, Bit_Vector_Type_Definition); - Add_Decl (Bit_Vector_Type); - Set_Type_Declarator (Bit_Vector_Type_Definition, Bit_Vector_Type); - - Add_Implicit_Operations (Bit_Vector_Type); - end; + Create_Array_Type (Bit_Vector_Type_Definition, Bit_Vector_Type, + Bit_Type_Definition, Name_Bit_Vector); + + if Vhdl_Std >= Vhdl_08 then + -- integer_vector type. + -- type integer_vector is array (natural range <>) of Integer; + Create_Array_Type + (Integer_Vector_Type_Definition, Integer_Vector_Type, + Integer_Type_Definition, Name_Integer_Vector); + end if; -- time definition declare @@ -963,5 +1044,20 @@ package body Std_Package is else Foreign_Attribute := Null_Iir; end if; + + if Vhdl_Std >= Vhdl_08 then + Create_To_String (Boolean_Type_Definition); + Create_To_String (Bit_Type_Definition); + Create_To_String (Character_Type_Definition); + Create_To_String (Severity_Level_Type_Definition); + Create_To_String (Universal_Integer_Type_Definition); + Create_To_String (Universal_Real_Type_Definition); + Create_To_String (Integer_Type_Definition); + Create_To_String (Real_Type_Definition); + Create_To_String (Time_Type_Definition); + Create_To_String (File_Open_Kind_Type_Definition); + Create_To_String (File_Open_Status_Type_Definition); + end if; + end Create_Std_Standard_Package; end Std_Package; diff --git a/std_package.ads b/std_package.ads index 0182ff8c1..1b7ae4f1c 100644 --- a/std_package.ads +++ b/std_package.ads @@ -136,6 +136,10 @@ package Std_Package is -- atribute foreign : string; Foreign_Attribute : Iir_Attribute_Declaration; + -- For VHDL-08 + Integer_Vector_Type_Definition : Iir_Array_Type_Definition; + Integer_Vector_Type : Iir_Type_Declaration; + -- Internal use only. -- These types should be considered like universal types, but -- furthermore, they can be converted to any integer/real types while diff --git a/tokens.adb b/tokens.adb index 07dd1ac7a..ffbad10be 100644 --- a/tokens.adb +++ b/tokens.adb @@ -87,7 +87,20 @@ package body Tokens is when Tok_Greater_Equal => return ">="; - -- sign token + when Tok_Match_Equal => + return "?="; + when Tok_Match_Not_Equal => + return "?/="; + when Tok_Match_Less => + return "?<"; + when Tok_Match_Less_Equal => + return "?<="; + when Tok_Match_Greater => + return "?>"; + when Tok_Match_Greater_Equal => + return "?>="; + + -- sign token when Tok_Plus => return "+"; when Tok_Minus => diff --git a/tokens.ads b/tokens.ads index c331c099e..41b50f24d 100644 --- a/tokens.ads +++ b/tokens.ads @@ -57,6 +57,13 @@ package Tokens is Tok_Greater, -- > Tok_Greater_Equal, -- >= + Tok_Match_Equal, -- ?= + Tok_Match_Not_Equal, -- ?/= + Tok_Match_Less, -- ?< + Tok_Match_Less_Equal, -- ?<= + Tok_Match_Greater, -- ?> + Tok_Match_Greater_Equal, -- ?>= + -- sign token Tok_Plus, -- + Tok_Minus, -- - @@ -252,7 +259,7 @@ package Tokens is -- subtype Token_Relation_Type is Token_Type range Tok_And .. Tok_Xnor; subtype Token_Relational_Operator_Type is Token_Type range - Tok_Equal .. Tok_Greater_Equal; + Tok_Equal .. Tok_Match_Greater_Equal; subtype Token_Shift_Operator_Type is Token_Type range Tok_Sll .. Tok_Ror; subtype Token_Sign_Type is Token_Type range diff --git a/translate/ghdldrv/Makefile b/translate/ghdldrv/Makefile index 47f6e0f23..51592ae9e 100644 --- a/translate/ghdldrv/Makefile +++ b/translate/ghdldrv/Makefile @@ -139,7 +139,7 @@ $(LIB87_DIR)/std/std_standard.bc: $(GHDL1LLVM) install.v93: std.v93 ieee.v93 synopsys.v93 mentor.v93 install.v87: std.v87 ieee.v87 synopsys.v87 -install.v08: std.v08 +install.v08: std.v08 ieee.v08 install.standard: $(LIB93_DIR)/std/std_standard.o \ $(LIB87_DIR)/std/std_standard.o diff --git a/translate/translation.adb b/translate/translation.adb index 6da25dec8..6f16183ce 100644 --- a/translate/translation.adb +++ b/translate/translation.adb @@ -4706,7 +4706,13 @@ package body Translation is Std_Names.Name_Op_Div => "OPDi", Std_Names.Name_Op_Exp => "OPEx", Std_Names.Name_Op_Concatenation => "OPCc", - Std_Names.Name_Op_Condition => "OPCd"); + Std_Names.Name_Op_Condition => "OPCd", + Std_Names.Name_Op_Match_Equality => "OPQe", + Std_Names.Name_Op_Match_Inequality => "OPQi", + Std_Names.Name_Op_Match_Less => "OPQL", + Std_Names.Name_Op_Match_Less_Equal => "OPQl", + Std_Names.Name_Op_Match_Greater => "OPQG", + Std_Names.Name_Op_Match_Greater_Equal => "OPQg"); -- Set the identifier prefix with the subprogram identifier and -- overload number if any. |