diff options
| -rw-r--r-- | src/vhdl/vhdl-evaluation.adb | 202 |
1 files changed, 94 insertions, 108 deletions
diff --git a/src/vhdl/vhdl-evaluation.adb b/src/vhdl/vhdl-evaluation.adb index d92e859b3..31b44768b 100644 --- a/src/vhdl/vhdl-evaluation.adb +++ b/src/vhdl/vhdl-evaluation.adb @@ -4216,6 +4216,17 @@ package body Vhdl.Evaluation is end case; end Int_In_Range; + function Null_Fp_Range + (Dir : Direction_Type; L, R : Fp64) return Boolean is + begin + case Dir is + when Dir_To => + return L > R; + when Dir_Downto => + return L < R; + end case; + end Null_Fp_Range; + function Fp_In_Range (Val : Fp64; Dir : Direction_Type; L, R : Fp64) return Boolean is begin @@ -4490,117 +4501,11 @@ package body Vhdl.Evaluation is return Null_Int_Range (Dir, Eval_Pos (L_Expr), Eval_Pos (R_Expr)); when Iir_Kind_Floating_Subtype_Definition | Iir_Kind_Floating_Type_Definition => - declare - L, R : Fp64; - begin - L := Get_Fp_Value (L_Expr); - R := Get_Fp_Value (R_Expr); - case Dir is - when Dir_To => - return L > R; - when Dir_Downto => - return L < R; - end case; - end; + return Null_Fp_Range + (Dir, Get_Fp_Value (L_Expr), Get_Fp_Value (R_Expr)); end case; end Is_Null_Range; - -- Check range expression A_RANGE. - procedure Eval_Check_Range_In_Bound (A_Range : Iir; - Sub_Type : Iir; - Dir_Ok : out Boolean; - Left_Ok : out Boolean; - Right_Ok : out Boolean) - is - Range_Constraint : constant Iir := Eval_Static_Range (A_Range); - L_Expr : constant Iir := Get_Left_Limit (Range_Constraint); - R_Expr : constant Iir := Get_Right_Limit (Range_Constraint); - Dir : constant Direction_Type := Get_Direction (Range_Constraint); - Type_Range : constant Iir := Get_Range_Constraint (Sub_Type); - begin - Dir_Ok := Get_Direction (Type_Range) = Dir; - - Left_Ok := True; - Right_Ok := True; - - -- In case of overflow, assume ok. - if Is_Overflow_Literal (L_Expr) - or else Is_Overflow_Literal (R_Expr) - then - return; - end if; - - case Get_Kind (Sub_Type) is - when Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Enumeration_Type_Definition => - declare - L, R : Int64; - begin - -- Check for null range. - L := Eval_Pos (L_Expr); - R := Eval_Pos (R_Expr); - case Dir is - when Dir_To => - if L > R then - return; - end if; - when Dir_Downto => - if L < R then - return; - end if; - end case; - Left_Ok := Eval_Int_In_Range (L, Type_Range); - Right_Ok := Eval_Int_In_Range (R, Type_Range); - end; - when Iir_Kind_Floating_Subtype_Definition => - declare - L, R : Fp64; - begin - -- Check for null range. - L := Get_Fp_Value (L_Expr); - R := Get_Fp_Value (R_Expr); - case Dir is - when Dir_To => - if L > R then - return; - end if; - when Dir_Downto => - if L < R then - return; - end if; - end case; - Left_Ok := Eval_Fp_In_Range (L, Type_Range); - Right_Ok := Eval_Fp_In_Range (R, Type_Range); - end; - when others => - Error_Kind ("eval_check_range_in_bound", Sub_Type); - end case; - end Eval_Check_Range_In_Bound; - - function Eval_Is_Range_In_Bound - (A_Range : Iir; Sub_Type : Iir; Any_Dir : Boolean) return Boolean - is - L_Ok, R_Ok, Dir_Ok : Boolean; - begin - Eval_Check_Range_In_Bound (A_Range, Sub_Type, Dir_Ok, L_Ok, R_Ok); - if not Any_Dir and then not Dir_Ok then - return True; - end if; - - return L_Ok and R_Ok; - end Eval_Is_Range_In_Bound; - - procedure Eval_Check_Range - (A_Range : Iir; Sub_Type : Iir; Any_Dir : Boolean) is - begin - if not Eval_Is_Range_In_Bound (A_Range, Sub_Type, Any_Dir) then - Warning_Msg_Sem (Warnid_Runtime_Error, +A_Range, - "static range violates bounds"); - end if; - end Eval_Check_Range; - function Eval_Discrete_Range_Length (Constraint : Iir) return Int64 is -- We don't want to deal with very large ranges here. @@ -4844,6 +4749,87 @@ package body Vhdl.Evaluation is end loop; end Eval_Static_Range; + -- Check range expression A_RANGE. + procedure Eval_Check_Range_In_Bound (A_Range : Iir; + Sub_Type : Iir; + Dir_Ok : out Boolean; + Left_Ok : out Boolean; + Right_Ok : out Boolean) + is + Type_Range : constant Iir := Get_Range_Constraint (Sub_Type); + L_Expr, R_Expr : Iir; + Dir : Direction_Type; + begin + Eval_Range_Bounds (A_Range, Dir, L_Expr, R_Expr); + Dir_Ok := Get_Direction (Type_Range) = Dir; + + Left_Ok := True; + Right_Ok := True; + + -- In case of overflow, assume ok. + if Is_Overflow_Literal (L_Expr) + or else Is_Overflow_Literal (R_Expr) + then + return; + end if; + + case Get_Kind (Sub_Type) is + when Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Physical_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Enumeration_Type_Definition => + declare + L, R : Int64; + begin + -- Check for null range. + L := Eval_Pos (L_Expr); + R := Eval_Pos (R_Expr); + if Null_Int_Range (Dir, L, R) then + return; + end if; + Left_Ok := Eval_Int_In_Range (L, Type_Range); + Right_Ok := Eval_Int_In_Range (R, Type_Range); + end; + when Iir_Kind_Floating_Subtype_Definition => + declare + L, R : Fp64; + begin + -- Check for null range. + L := Get_Fp_Value (L_Expr); + R := Get_Fp_Value (R_Expr); + if Null_Fp_Range (Dir, L, R) then + return; + end if; + Left_Ok := Eval_Fp_In_Range (L, Type_Range); + Right_Ok := Eval_Fp_In_Range (R, Type_Range); + end; + when others => + Error_Kind ("eval_check_range_in_bound", Sub_Type); + end case; + end Eval_Check_Range_In_Bound; + + function Eval_Is_Range_In_Bound + (A_Range : Iir; Sub_Type : Iir; Any_Dir : Boolean) return Boolean + is + L_Ok, R_Ok, Dir_Ok : Boolean; + begin + Eval_Check_Range_In_Bound (A_Range, Sub_Type, Dir_Ok, L_Ok, R_Ok); + if not Any_Dir and then not Dir_Ok then + return True; + end if; + + return L_Ok and R_Ok; + end Eval_Is_Range_In_Bound; + + procedure Eval_Check_Range + (A_Range : Iir; Sub_Type : Iir; Any_Dir : Boolean) is + begin + if not Eval_Is_Range_In_Bound (A_Range, Sub_Type, Any_Dir) then + Warning_Msg_Sem (Warnid_Runtime_Error, +A_Range, + "static range violates bounds"); + end if; + end Eval_Check_Range; + procedure Check_Range_Compatibility (Inner : Iir; Outer : Iir) is pragma Assert (Get_Kind (Inner) = Iir_Kind_Range_Expression); |