diff options
Diffstat (limited to 'src/vhdl/vhdl-sem_stmts.adb')
| -rw-r--r-- | src/vhdl/vhdl-sem_stmts.adb | 281 |
1 files changed, 238 insertions, 43 deletions
diff --git a/src/vhdl/vhdl-sem_stmts.adb b/src/vhdl/vhdl-sem_stmts.adb index 35d49fc33..4a420b3a1 100644 --- a/src/vhdl/vhdl-sem_stmts.adb +++ b/src/vhdl/vhdl-sem_stmts.adb @@ -41,6 +41,8 @@ package body Vhdl.Sem_Stmts is -- get_associated_chain (for case statement). procedure Sem_Sequential_Statements_Internal (First_Stmt : Iir); + procedure Sem_Simultaneous_Statements (First : Iir); + -- Access to the current subprogram or process. Current_Subprogram: Iir := Null_Iir; @@ -694,10 +696,23 @@ package body Vhdl.Sem_Stmts is Set_Guard (Stmt, Guard); end Sem_Guard; + -- Analyze optional Condition field of PARENT. + procedure Sem_Condition_Opt (Parent : Iir) + is + Cond : Iir; + begin + Cond := Get_Condition (Parent); + if Cond /= Null_Iir then + Cond := Sem_Condition (Cond); + if Cond /= Null_Iir then + Set_Condition (Parent, Cond); + end if; + end if; + end Sem_Condition_Opt; + procedure Sem_Signal_Assignment (Stmt: Iir) is Cond_Wf : Iir_Conditional_Waveform; - Expr : Iir; Wf_Chain : Iir_Waveform_Element; Target_Type : Iir; Done : Boolean; @@ -731,13 +746,7 @@ package body Vhdl.Sem_Stmts is end if; if S = Resolve_Stage_1 then -- Must be analyzed only once. - Expr := Get_Condition (Cond_Wf); - if Expr /= Null_Iir then - Expr := Sem_Condition (Expr); - if Expr /= Null_Iir then - Set_Condition (Cond_Wf, Expr); - end if; - end if; + Sem_Condition_Opt (Cond_Wf); end if; Cond_Wf := Get_Chain (Cond_Wf); end loop; @@ -1174,7 +1183,8 @@ package body Vhdl.Sem_Stmts is case Get_Kind (Prefix) is when Iir_Kind_Signal_Declaration | Iir_Kind_Guard_Signal_Declaration - | Iir_Kinds_Signal_Attribute => + | Iir_Kinds_Signal_Attribute + | Iir_Kind_Above_Attribute => null; when Iir_Kind_Interface_Signal_Declaration => if not Is_Interface_Signal_Readable (Prefix) then @@ -1234,6 +1244,71 @@ package body Vhdl.Sem_Stmts is end loop; end Mark_Suspendable; + function Sem_Real_Or_Time_Timeout (Expr : Iir) return Iir + is + Res : Iir; + Res_Type : Iir; + begin + Res := Sem_Expression_Ov (Expr, Null_Iir); + + if Res = Null_Iir then + -- Error occurred. + return Res; + end if; + + Res_Type := Get_Type (Res); + if not Is_Overload_List (Res_Type) then + Res_Type := Get_Base_Type (Get_Type (Res)); + if Res_Type = Time_Type_Definition + or else Res_Type = Real_Type_Definition + then + Check_Read (Res); + return Res; + else + Error_Msg_Sem + (+Expr, "timeout expression must be of type time or real"); + return Expr; + end if; + else + -- Many interpretations. + declare + Res_List : constant Iir_List := Get_Overload_List (Res_Type); + It : List_Iterator; + El : Iir; + Nbr_Res : Natural; + begin + Nbr_Res := 0; + + -- Extract boolean interpretations. + It := List_Iterate (Res_List); + while Is_Valid (It) loop + El := Get_Base_Type (Get_Element (It)); + if Are_Basetypes_Compatible (El, Time_Type_Definition) + /= Not_Compatible + then + Res_Type := Time_Type_Definition; + Nbr_Res := Nbr_Res + 1; + elsif Are_Basetypes_Compatible (El, Real_Type_Definition) + /= Not_Compatible + then + Res_Type := Real_Type_Definition; + Nbr_Res := Nbr_Res + 1; + end if; + Next (It); + end loop; + + if Nbr_Res = 1 then + Res := Sem_Expression_Ov (Expr, Res_Type); + Check_Read (Res); + return Res; + else + Error_Overload (Expr); + return Expr; + end if; + end; + end if; + end Sem_Real_Or_Time_Timeout; + procedure Sem_Wait_Statement (Stmt: Iir_Wait_Statement) is Expr: Iir; @@ -1285,15 +1360,20 @@ package body Vhdl.Sem_Stmts is Expr := Get_Timeout_Clause (Stmt); if Expr /= Null_Iir then - Expr := Sem_Expression (Expr, Time_Type_Definition); - if Expr /= Null_Iir then - Check_Read (Expr); - Expr := Eval_Expr_If_Static (Expr); + if AMS_Vhdl then + Expr := Sem_Real_Or_Time_Timeout (Expr); Set_Timeout_Clause (Stmt, Expr); - if Get_Expr_Staticness (Expr) = Locally - and then Get_Physical_Value (Expr) < 0 - then - Error_Msg_Sem (+Stmt, "timeout value must be positive"); + else + Expr := Sem_Expression (Expr, Time_Type_Definition); + if Expr /= Null_Iir then + Check_Read (Expr); + Expr := Eval_Expr_If_Static (Expr); + Set_Timeout_Clause (Stmt, Expr); + if Get_Expr_Staticness (Expr) = Locally + and then Get_Physical_Value (Expr) < 0 + then + Error_Msg_Sem (+Stmt, "timeout value must be positive"); + end if; end if; end if; end if; @@ -1303,17 +1383,12 @@ package body Vhdl.Sem_Stmts is procedure Sem_Exit_Next_Statement (Stmt : Iir) is - Cond: Iir; Loop_Label : Iir; Loop_Stmt: Iir; P : Iir; begin -- Analyze condition (if present). - Cond := Get_Condition (Stmt); - if Cond /= Null_Iir then - Cond := Sem_Condition (Cond); - Set_Condition (Stmt, Cond); - end if; + Sem_Condition_Opt (Stmt); -- Analyze label. Loop_Label := Get_Loop_Label (Stmt); @@ -1361,6 +1436,84 @@ package body Vhdl.Sem_Stmts is end loop; end Sem_Exit_Next_Statement; + function Sem_Quantity_Name (Name : Iir) return Iir + is + Res : Iir; + begin + Sem_Name (Name); + + Res := Get_Named_Entity (Name); + + if Res = Error_Mark then + return Null_Iir; + elsif Is_Overload_List (Res) then + Error_Msg_Sem (+Name, "quantity name expected"); + return Null_Iir; + else + Res := Finish_Sem_Name (Name); + if not Is_Quantity_Name (Res) then + Error_Msg_Sem (+Name, "%n is not a quantity name", +Res); + return Null_Iir; + else + return Res; + end if; + end if; + end Sem_Quantity_Name; + + procedure Sem_Break_List (First : Iir) + is + El : Iir; + Name : Iir; + Break_Quantity : Iir; + Sel_Quantity : Iir; + Expr : Iir; + Expr_Type : Iir; + begin + El := First; + while El /= Null_Iir loop + Name := Get_Break_Quantity (El); + Break_Quantity := Sem_Quantity_Name (Name); + + -- AMS-LRM17 10.15 Break statement + -- The break quantity, the selector quantity, and the expression + -- shall have the same type [...] + if Break_Quantity /= Null_Iir then + Set_Break_Quantity (El, Break_Quantity); + Expr_Type := Get_Type (Break_Quantity); + else + Expr_Type := Null_Iir; + end if; + + Expr := Get_Expression (El); + Expr := Sem_Expression (Expr, Expr_Type); + if Expr /= Null_Iir then + Set_Expression (El, Expr); + end if; + + Sel_Quantity := Get_Selector_Quantity (El); + if Sel_Quantity /= Null_Iir then + Sel_Quantity := Sem_Quantity_Name (Name); + if Sel_Quantity /= Null_Iir and then Expr_Type /= Null_Iir then + if Is_Expr_Compatible (Expr_Type, Sel_Quantity) = Not_Compatible + then + Error_Msg_Sem (+Sel_Quantity, + "selector quantity must be of the same type " + & "as the break quantity"); + end if; + end if; + end if; + + El := Get_Chain (El); + end loop; + end Sem_Break_List; + + procedure Sem_Break_Statement (Stmt : Iir) is + begin + Sem_Break_List (Get_Break_Element (Stmt)); + + Sem_Condition_Opt (Stmt); + end Sem_Break_Statement; + -- Process is the scope, this is also the process for which drivers can -- be created. procedure Sem_Sequential_Statements_Internal (First_Stmt : Iir) @@ -1375,14 +1528,9 @@ package body Vhdl.Sem_Stmts is when Iir_Kind_If_Statement => declare Clause: Iir := Stmt; - Cond: Iir; begin while Clause /= Null_Iir loop - Cond := Get_Condition (Clause); - if Cond /= Null_Iir then - Cond := Sem_Condition (Cond); - Set_Condition (Clause, Cond); - end if; + Sem_Condition_Opt (Clause); Sem_Sequential_Statements_Internal (Get_Sequential_Statement_Chain (Clause)); Clause := Get_Else_Clause (Clause); @@ -1408,17 +1556,9 @@ package body Vhdl.Sem_Stmts is Close_Declarative_Region; end; when Iir_Kind_While_Loop_Statement => - declare - Cond: Iir; - begin - Cond := Get_Condition (Stmt); - if Cond /= Null_Iir then - Cond := Sem_Condition (Cond); - Set_Condition (Stmt, Cond); - end if; - Sem_Sequential_Statements_Internal - (Get_Sequential_Statement_Chain (Stmt)); - end; + Sem_Condition_Opt (Stmt); + Sem_Sequential_Statements_Internal + (Get_Sequential_Statement_Chain (Stmt)); when Iir_Kind_Simple_Signal_Assignment_Statement | Iir_Kind_Conditional_Signal_Assignment_Statement => Sem_Signal_Assignment (Stmt); @@ -1443,6 +1583,8 @@ package body Vhdl.Sem_Stmts is Sem_Case_Statement (Stmt); when Iir_Kind_Wait_Statement => Sem_Wait_Statement (Stmt); + when Iir_Kind_Break_Statement => + Sem_Break_Statement (Stmt); when Iir_Kind_Procedure_Call_Statement => declare Call : constant Iir := Get_Procedure_Call (Stmt); @@ -1940,7 +2082,22 @@ package body Vhdl.Sem_Stmts is Sem_Guard (Stmt); end Sem_Concurrent_Selected_Signal_Assignment; - procedure Simple_Simultaneous_Statement (Stmt : Iir) is + procedure Sem_Concurrent_Break_Statement (Stmt : Iir) + is + Sensitivity_List : Iir_List; + begin + Sem_Break_List (Get_Break_Element (Stmt)); + + Sensitivity_List := Get_Sensitivity_List (Stmt); + if Sensitivity_List /= Null_Iir_List then + Sem_Sensitivity_List (Sensitivity_List); + end if; + + Sem_Condition_Opt (Stmt); + end Sem_Concurrent_Break_Statement; + + procedure Sem_Simple_Simultaneous_Statement (Stmt : Iir) + is Left, Right : Iir; Res_Type : Iir; begin @@ -1955,6 +2112,9 @@ package body Vhdl.Sem_Stmts is return; end if; + Set_Simultaneous_Left (Stmt, Left); + Set_Simultaneous_Right (Stmt, Right); + Res_Type := Search_Compatible_Type (Get_Type (Left), Get_Type (Right)); if Res_Type = Null_Iir then Error_Msg_Sem @@ -1963,7 +2123,38 @@ package body Vhdl.Sem_Stmts is end if; -- FIXME: check for nature type... - end Simple_Simultaneous_Statement; + end Sem_Simple_Simultaneous_Statement; + + procedure Sem_Simultaneous_If_Statement (Stmt : Iir) + is + Clause : Iir; + begin + Clause := Stmt; + while Clause /= Null_Iir loop + Sem_Condition_Opt (Clause); + Sem_Simultaneous_Statements + (Get_Simultaneous_Statement_Chain (Clause)); + Clause := Get_Else_Clause (Clause); + end loop; + end Sem_Simultaneous_If_Statement; + + procedure Sem_Simultaneous_Statements (First : Iir) + is + Stmt : Iir; + begin + Stmt := First; + while Stmt /= Null_Iir loop + case Get_Kind (Stmt) is + when Iir_Kind_Simple_Simultaneous_Statement => + Sem_Simple_Simultaneous_Statement (Stmt); + when Iir_Kind_Simultaneous_If_Statement => + Sem_Simultaneous_If_Statement (Stmt); + when others => + Error_Kind ("sem_simultaneous_statements", Stmt); + end case; + Stmt := Get_Chain (Stmt); + end loop; + end Sem_Simultaneous_Statements; procedure Sem_Concurrent_Statement (Stmt : in out Iir; Is_Passive : Boolean) is @@ -2019,6 +2210,8 @@ package body Vhdl.Sem_Stmts is when Iir_Kind_Concurrent_Procedure_Call_Statement => Stmt := Sem_Concurrent_Procedure_Call_Statement (Stmt, Is_Passive); + when Iir_Kind_Concurrent_Break_Statement => + Sem_Concurrent_Break_Statement (Stmt); when Iir_Kind_Psl_Declaration => Sem_Psl.Sem_Psl_Declaration (Stmt); when Iir_Kind_Psl_Endpoint_Declaration => @@ -2034,7 +2227,9 @@ package body Vhdl.Sem_Stmts is when Iir_Kind_Psl_Default_Clock => Sem_Psl.Sem_Psl_Default_Clock (Stmt); when Iir_Kind_Simple_Simultaneous_Statement => - Simple_Simultaneous_Statement (Stmt); + Sem_Simple_Simultaneous_Statement (Stmt); + when Iir_Kind_Simultaneous_If_Statement => + Sem_Simultaneous_If_Statement (Stmt); when others => Error_Kind ("sem_concurrent_statement", Stmt); end case; |