diff options
| -rw-r--r-- | iirs.adb | 52 | ||||
| -rw-r--r-- | iirs.ads | 20 | ||||
| -rw-r--r-- | sem_names.adb | 25 | ||||
| -rw-r--r-- | sem_stmts.ads | 3 | ||||
| -rw-r--r-- | testsuite/gna/ticket20/morten1.vhdl | 91 | ||||
| -rwxr-xr-x | testsuite/gna/ticket20/testsuite.sh | 8 |
6 files changed, 194 insertions, 5 deletions
@@ -2544,10 +2544,34 @@ package body Iirs is | Iir_Kind_Indexed_Name | Iir_Kind_Selected_Name | Iir_Kind_Selected_By_All_Name + | Iir_Kind_Left_Type_Attribute + | Iir_Kind_Right_Type_Attribute + | Iir_Kind_High_Type_Attribute + | Iir_Kind_Low_Type_Attribute + | Iir_Kind_Ascending_Type_Attribute + | Iir_Kind_Image_Attribute + | Iir_Kind_Value_Attribute + | Iir_Kind_Pos_Attribute + | Iir_Kind_Val_Attribute + | Iir_Kind_Succ_Attribute + | Iir_Kind_Pred_Attribute + | Iir_Kind_Leftof_Attribute + | Iir_Kind_Rightof_Attribute | Iir_Kind_Delayed_Attribute | Iir_Kind_Stable_Attribute | Iir_Kind_Quiet_Attribute - | Iir_Kind_Transaction_Attribute => + | Iir_Kind_Transaction_Attribute + | Iir_Kind_Simple_Name_Attribute + | Iir_Kind_Instance_Name_Attribute + | Iir_Kind_Path_Name_Attribute + | Iir_Kind_Left_Array_Attribute + | Iir_Kind_Right_Array_Attribute + | Iir_Kind_High_Array_Attribute + | Iir_Kind_Low_Array_Attribute + | Iir_Kind_Length_Array_Attribute + | Iir_Kind_Ascending_Array_Attribute + | Iir_Kind_Range_Array_Attribute + | Iir_Kind_Reverse_Range_Array_Attribute => null; when others => Failed ("Base_Name", Target); @@ -6101,6 +6125,19 @@ package body Iirs is | Iir_Kind_Implicit_Dereference | Iir_Kind_Slice_Name | Iir_Kind_Indexed_Name + | Iir_Kind_Left_Type_Attribute + | Iir_Kind_Right_Type_Attribute + | Iir_Kind_High_Type_Attribute + | Iir_Kind_Low_Type_Attribute + | Iir_Kind_Ascending_Type_Attribute + | Iir_Kind_Image_Attribute + | Iir_Kind_Value_Attribute + | Iir_Kind_Pos_Attribute + | Iir_Kind_Val_Attribute + | Iir_Kind_Succ_Attribute + | Iir_Kind_Pred_Attribute + | Iir_Kind_Leftof_Attribute + | Iir_Kind_Rightof_Attribute | Iir_Kind_Delayed_Attribute | Iir_Kind_Stable_Attribute | Iir_Kind_Quiet_Attribute @@ -6111,7 +6148,18 @@ package body Iirs is | Iir_Kind_Last_Active_Attribute | Iir_Kind_Last_Value_Attribute | Iir_Kind_Driving_Attribute - | Iir_Kind_Driving_Value_Attribute => + | Iir_Kind_Driving_Value_Attribute + | Iir_Kind_Simple_Name_Attribute + | Iir_Kind_Instance_Name_Attribute + | Iir_Kind_Path_Name_Attribute + | Iir_Kind_Left_Array_Attribute + | Iir_Kind_Right_Array_Attribute + | Iir_Kind_High_Array_Attribute + | Iir_Kind_Low_Array_Attribute + | Iir_Kind_Length_Array_Attribute + | Iir_Kind_Ascending_Array_Attribute + | Iir_Kind_Range_Array_Attribute + | Iir_Kind_Reverse_Range_Array_Attribute => null; when others => Failed ("Name_Staticness", Target); @@ -2578,7 +2578,11 @@ package Iirs is -- -- Get/Set_Prefix (Field3) -- + -- Get/Set_Base_Name (Field5) + -- -- Get/Set_Expr_Staticness (State1) + -- + -- Get/Set_Name_Staticness (State2) -- Iir_Kind_Range_Array_Attribute (Short) -- Iir_Kind_Reverse_Range_Array_Attribute (Short) @@ -2597,7 +2601,11 @@ package Iirs is -- -- Get/Set_Parameter (Field4) -- + -- Get/Set_Base_Name (Field5) + -- -- Get/Set_Expr_Staticness (State1) + -- + -- Get/Set_Name_Staticness (State2) -- Iir_Kind_Stable_Attribute (Short) -- Iir_Kind_Delayed_Attribute (Short) @@ -2651,7 +2659,11 @@ package Iirs is -- -- Get/Set_Parameter (Field4) -- + -- Get/Set_Base_Name (Field5) + -- -- Get/Set_Expr_Staticness (State1) + -- + -- Get/Set_Name_Staticness (State2) -- Iir_Kind_Image_Attribute (Short) -- Iir_Kind_Value_Attribute (Short) @@ -2662,7 +2674,11 @@ package Iirs is -- -- Get/Set_Parameter (Field4) -- + -- Get/Set_Base_Name (Field5) + -- -- Get/Set_Expr_Staticness (State1) + -- + -- Get/Set_Name_Staticness (State2) -- Iir_Kind_Simple_Name_Attribute (Short) -- Iir_Kind_Instance_Name_Attribute (Short) @@ -2675,7 +2691,11 @@ package Iirs is -- Only for Iir_Kind_Simple_Name_Attribute: -- Get/Set_Simple_Name_Identifier (Field2) -- + -- Get/Set_Base_Name (Field5) + -- -- Get/Set_Expr_Staticness (State1) + -- + -- Get/Set_Name_Staticness (State2) -- Iir_Kind_Behavior_Attribute (Short) -- Iir_Kind_Structure_Attribute (Short) diff --git a/sem_names.adb b/sem_names.adb index 23562cb..e7bfe6e 100644 --- a/sem_names.adb +++ b/sem_names.adb @@ -763,6 +763,10 @@ package body Sem_Names is raise Internal_Error; end case; + if Get_Parameter (Attr) /= Null_Iir then + raise Internal_Error; + end if; + Set_Parameter (Attr, Parameter); if Get_Kind (Prefix_Type) = Iir_Kind_Array_Subtype_Definition then Set_Index_Subtype (Attr, Index_Type); @@ -852,6 +856,9 @@ package body Sem_Names is when others => raise Internal_Error; end case; + if Get_Parameter (Attr) /= Null_Iir then + raise Internal_Error; + end if; if Parameter = Null_Iir then Set_Parameter (Attr, Param); Set_Expr_Staticness (Attr, None); @@ -860,6 +867,7 @@ package body Sem_Names is Set_Parameter (Attr, Parameter); Set_Expr_Staticness (Attr, Min (Get_Type_Staticness (Prefix_Type), Get_Expr_Staticness (Parameter))); + Set_Name_Staticness (Attr, Get_Expr_Staticness (Attr)); end Finish_Sem_Scalar_Type_Attribute; procedure Finish_Sem_Signal_Attribute (Attr : Iir; Parameter : Iir) @@ -1069,6 +1077,8 @@ package body Sem_Names is Finish_Sem_Name (Name_Pfx, Pfx); end if; end if; + when Iir_Kinds_Attribute => + null; when others => Error_Kind ("finish_sem_implicits", Pfx); end case; @@ -2043,14 +2053,20 @@ package body Sem_Names is when Iir_Kinds_Scalar_Type_Attribute | Iir_Kind_Image_Attribute | Iir_Kind_Value_Attribute => - if Actual /= Null_Iir then + if Get_Parameter (Prefix) /= Null_Iir then + -- Attribute already has a parameter, the expression + -- is either a slice or an index. + Add_Result + (Res, Sem_As_Indexed_Or_Slice_Name (Prefix, True)); + elsif Actual /= Null_Iir then Finish_Sem_Scalar_Type_Attribute (Prefix, Actual); Set_Named_Entity (Name, Prefix); + return; else Error_Msg_Sem ("bad attribute parameter", Name); Set_Named_Entity (Name, Error_Mark); + return; end if; - return; when Iir_Kind_Type_Declaration | Iir_Kind_Subtype_Declaration => @@ -2361,6 +2377,7 @@ package body Sem_Names is end case; Location_Copy (Res, Attr); Set_Prefix (Res, Prefix); + Set_Base_Name (Res, Res); case Get_Attribute_Identifier (Attr) is when Name_Pos => @@ -2427,6 +2444,8 @@ package body Sem_Names is Location_Copy (Res, Attr); Prefix := Get_Named_Entity (Get_Prefix (Attr)); Set_Prefix (Res, Prefix); + Set_Base_Name (Res, Res); + Prefix_Type := Get_Type (Prefix); case Get_Attribute_Identifier (Attr) is when Name_Ascending => @@ -3366,7 +3385,7 @@ package body Sem_Names is | Iir_Kind_Dereference | Iir_Kind_Attribute_Value | Iir_Kind_Function_Call - | Iir_Kinds_Signal_Attribute => + | Iir_Kinds_Attribute => return True; when Iir_Kind_Simple_Name | Iir_Kind_Selected_Name => diff --git a/sem_stmts.ads b/sem_stmts.ads index 59102af..d3eeb8c 100644 --- a/sem_stmts.ads +++ b/sem_stmts.ads @@ -56,6 +56,9 @@ package Sem_Stmts is -- This is used by processes and subprograms semantization. procedure Sem_Sequential_Statements (Decl : Iir; Body_Parent : Iir); + -- Sem for concurrent and sequential assertion statements. + procedure Sem_Report_Statement (Stmt : Iir); + -- Get the current subprogram or process. function Get_Current_Subprogram return Iir; pragma Inline (Get_Current_Subprogram); diff --git a/testsuite/gna/ticket20/morten1.vhdl b/testsuite/gna/ticket20/morten1.vhdl new file mode 100644 index 0000000..3881f65 --- /dev/null +++ b/testsuite/gna/ticket20/morten1.vhdl @@ -0,0 +1,91 @@ +library ieee; +use ieee.std_logic_1164.all; +use ieee.numeric_std.all; +-- library std; +use std.textio.all; + +entity morten is +end entity; + +architecture foo of morten is + + signal clk: std_logic := '0'; + signal rst: std_logic := '1'; + signal cnt_1: unsigned (7 downto 0); + signal cnt_3: unsigned (7 downto 0); + + function to_bstring(sl : std_logic) return string is + begin + return "" & std_logic'image(sl)(2); -- "" & character to get string + end function; + + function to_bstring(slv : std_logic_vector) return string is + alias slv_norm : std_logic_vector(1 to slv'length) is slv; + begin + if slv_norm'length = 0 then + return ""; + elsif slv_norm'length = 1 then + return to_bstring(slv_norm(1)); + else -- slv_norm'length > 0 + return to_bstring(slv_norm(1)) & to_bstring(slv_norm(2 to slv_norm'length)); + end if; + end function; + +begin + + +PRINT: + process (clk) is + variable line_v : line; + file out_file : text open write_mode is "out.txt"; + begin + if rising_edge(clk) then + write(line_v, to_bstring(rst) & " " & + to_bstring(std_logic_vector(cnt_1)) & " " & + to_bstring(std_logic_vector(cnt_3)) + ); + writeline(out_file, line_v); + end if; + end process; + +COUNTER1: + process (clk,rst) + begin + if rst = '1' then + cnt_1 <= (others => '0'); + elsif rising_edge(clk) then + cnt_1 <= cnt_1 + 1; + end if; + end process; + +COUNTER3: + process (clk,rst) + begin + if rst = '1' then + cnt_3 <= (others => '0'); + elsif rising_edge(clk) then + cnt_3 <= cnt_3 + 3; + end if; + end process; + +RESET: + process + begin + wait until rising_edge(clk); + wait until rising_edge(clk); + wait until rising_edge(clk); + rst <= '0'; + wait; + end process; + +CLOCK: + process + begin + wait for 10 ns; + clk <= not clk; + if Now > 210 ns then + wait; + end if; + end process; + +end architecture;
\ No newline at end of file diff --git a/testsuite/gna/ticket20/testsuite.sh b/testsuite/gna/ticket20/testsuite.sh new file mode 100755 index 0000000..79085ee --- /dev/null +++ b/testsuite/gna/ticket20/testsuite.sh @@ -0,0 +1,8 @@ +#!/bin/sh + +. ../../testenv.sh + +analyze morten1.vhdl +elab_simulate morten + +clean
\ No newline at end of file |