diff options
Diffstat (limited to 'src/grt')
-rw-r--r-- | src/grt/grt-lib.adb | 32 | ||||
-rw-r--r-- | src/grt/grt-lib.ads | 9 | ||||
-rw-r--r-- | src/grt/grt-types.ads | 3 |
3 files changed, 44 insertions, 0 deletions
diff --git a/src/grt/grt-lib.adb b/src/grt/grt-lib.adb index 653606a31..bc6ba2366 100644 --- a/src/grt/grt-lib.adb +++ b/src/grt/grt-lib.adb @@ -205,6 +205,38 @@ package body Grt.Lib is Error_E_Call_Stack (Bt); end Ghdl_Direction_Check_Failed; + procedure Diag_C_Range (Rng : Std_Integer_Range_Ptr) is + begin + Diag_C (Rng.Left); + case Rng.Dir is + when Dir_Downto => + Diag_C (" downto "); + when Dir_To => + Diag_C (" to "); + end case; + Diag_C (Rng.Right); + end Diag_C_Range; + + procedure Ghdl_Integer_Index_Check_Failed + (Filename : Ghdl_C_String; + Line : Ghdl_I32; + Val : Std_Integer; + Rng : Std_Integer_Range_Ptr) + is + Bt : Backtrace_Addrs; + begin + Save_Backtrace (Bt, 1); + Error_S ("index ("); + Diag_C (Val); + Diag_C (") out of bounds ("); + Diag_C_Range (Rng); + Diag_C (") at "); + Diag_C (Filename); + Diag_C (":"); + Diag_C (Line); + Error_E_Call_Stack (Bt); + end Ghdl_Integer_Index_Check_Failed; + function Hi (V : Ghdl_I64) return Ghdl_U32 is begin return Ghdl_U32 (Shift_Right (To_Ghdl_U64 (V), 32) and 16#ffff_ffff#); diff --git a/src/grt/grt-lib.ads b/src/grt/grt-lib.ads index b0f68d3e9..6e65a3188 100644 --- a/src/grt/grt-lib.ads +++ b/src/grt/grt-lib.ads @@ -54,6 +54,12 @@ package Grt.Lib is procedure Ghdl_Direction_Check_Failed (Filename : Ghdl_C_String; Line: Ghdl_I32); + procedure Ghdl_Integer_Index_Check_Failed + (Filename : Ghdl_C_String; + Line : Ghdl_I32; + Val : Std_Integer; + Rng : Std_Integer_Range_Ptr); + -- Program error has occurred: -- * configuration of an already configured block. procedure Ghdl_Program_Error (Filename : Ghdl_C_String; @@ -117,6 +123,9 @@ private "__ghdl_bound_check_failed"); pragma Export (C, Ghdl_Direction_Check_Failed, "__ghdl_direction_check_failed"); + pragma Export (C, Ghdl_Integer_Index_Check_Failed, + "__ghdl_integer_index_check_failed"); + pragma Export (C, Ghdl_Program_Error, "__ghdl_program_error"); pragma Export (C, Ghdl_Check_Stack_Allocation, diff --git a/src/grt/grt-types.ads b/src/grt/grt-types.ads index 0aa6dcc79..e59a38313 100644 --- a/src/grt/grt-types.ads +++ b/src/grt/grt-types.ads @@ -72,6 +72,9 @@ package Grt.Types is Length : Ghdl_Index_Type; end record; + type Std_Integer_Range_Ptr is access Std_Integer_Trt; + pragma Convention (C, Std_Integer_Range_Ptr); + subtype Std_Character is Character; type Std_String_Uncons is array (Ghdl_Index_Type range <>) of Std_Character; subtype Std_String_Base is Std_String_Uncons (Ghdl_Index_Type); |