diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/ghdldrv/ghdlrun.adb | 6 | ||||
-rw-r--r-- | src/grt/grt-lib.adb | 19 | ||||
-rw-r--r-- | src/grt/grt-lib.ads | 13 | ||||
-rw-r--r-- | src/vhdl/translate/trans-chap6.adb | 34 | ||||
-rw-r--r-- | src/vhdl/translate/trans_decls.ads | 3 | ||||
-rw-r--r-- | src/vhdl/translate/translation.adb | 23 |
6 files changed, 74 insertions, 24 deletions
diff --git a/src/ghdldrv/ghdlrun.adb b/src/ghdldrv/ghdlrun.adb index be4619815..2af331f67 100644 --- a/src/ghdldrv/ghdlrun.adb +++ b/src/ghdldrv/ghdlrun.adb @@ -245,8 +245,10 @@ package body Ghdlrun is Def (Trans_Decls.Ghdl_Memcpy, Grt.Lib.Ghdl_Memcpy'Address); - Def (Trans_Decls.Ghdl_Bound_Check_Failed_L1, - Grt.Lib.Ghdl_Bound_Check_Failed_L1'Address); + Def (Trans_Decls.Ghdl_Bound_Check_Failed, + Grt.Lib.Ghdl_Bound_Check_Failed'Address); + Def (Trans_Decls.Ghdl_Direction_Check_Failed, + Grt.Lib.Ghdl_Direction_Check_Failed'Address); Def (Trans_Decls.Ghdl_Malloc0, Grt.Lib.Ghdl_Malloc0'Address); Def (Trans_Decls.Ghdl_Std_Ulogic_To_Boolean_Array, diff --git a/src/grt/grt-lib.adb b/src/grt/grt-lib.adb index 9aa3558cc..c05e97ba3 100644 --- a/src/grt/grt-lib.adb +++ b/src/grt/grt-lib.adb @@ -164,8 +164,8 @@ package body Grt.Lib is Error_E (""); end Ghdl_Program_Error; - procedure Ghdl_Bound_Check_Failed_L1 (Filename : Ghdl_C_String; - Line: Ghdl_I32) + procedure Ghdl_Bound_Check_Failed (Filename : Ghdl_C_String; + Line: Ghdl_I32) is Bt : Backtrace_Addrs; begin @@ -175,7 +175,20 @@ package body Grt.Lib is Error_C (":"); Error_C (Integer (Line)); Error_E_Call_Stack (Bt); - end Ghdl_Bound_Check_Failed_L1; + end Ghdl_Bound_Check_Failed; + + procedure Ghdl_Direction_Check_Failed (Filename : Ghdl_C_String; + Line: Ghdl_I32) + is + Bt : Backtrace_Addrs; + begin + Save_Backtrace (Bt, 1); + Error_C ("slice direction doesn't match index direction at "); + Error_C (Filename); + Error_C (":"); + Error_C (Integer (Line)); + Error_E_Call_Stack (Bt); + end Ghdl_Direction_Check_Failed; function Ghdl_Integer_Exp (V : Ghdl_I32; E : Ghdl_I32) return Ghdl_I32 diff --git a/src/grt/grt-lib.ads b/src/grt/grt-lib.ads index 6e01ea9de..5d0fdfa57 100644 --- a/src/grt/grt-lib.ads +++ b/src/grt/grt-lib.ads @@ -55,8 +55,11 @@ package Grt.Lib is Error_Severity : constant Integer := 2; Failure_Severity : constant Integer := 3; - procedure Ghdl_Bound_Check_Failed_L1 (Filename : Ghdl_C_String; - Line: Ghdl_I32); + -- Bound / Direction error. + procedure Ghdl_Bound_Check_Failed (Filename : Ghdl_C_String; + Line: Ghdl_I32); + procedure Ghdl_Direction_Check_Failed (Filename : Ghdl_C_String; + Line: Ghdl_I32); -- Program error has occured: -- * configuration of an already configured block. @@ -113,8 +116,10 @@ private pragma Export (C, Ghdl_Psl_Cover_Failed, "__ghdl_psl_cover_failed"); pragma Export (C, Ghdl_Report, "__ghdl_report"); - pragma Export (C, Ghdl_Bound_Check_Failed_L1, - "__ghdl_bound_check_failed_l1"); + pragma Export (C, Ghdl_Bound_Check_Failed, + "__ghdl_bound_check_failed"); + pragma Export (C, Ghdl_Direction_Check_Failed, + "__ghdl_direction_check_failed"); pragma Export (C, Ghdl_Program_Error, "__ghdl_program_error"); pragma Export (C, Ghdl_Malloc, "__ghdl_malloc"); diff --git a/src/vhdl/translate/trans-chap6.adb b/src/vhdl/translate/trans-chap6.adb index cb31da86b..6cad50223 100644 --- a/src/vhdl/translate/trans-chap6.adb +++ b/src/vhdl/translate/trans-chap6.adb @@ -54,11 +54,24 @@ package body Trans.Chap6 is begin Files_Map.Location_To_Position (Get_Location (Loc), Name, Line, Col); - Start_Association (Constr, Ghdl_Bound_Check_Failed_L1); + Start_Association (Constr, Ghdl_Bound_Check_Failed); Assoc_Filename_Line (Constr, Line); New_Procedure_Call (Constr); end Gen_Bound_Error; + procedure Gen_Direction_Error (Loc : Iir) + is + Constr : O_Assoc_List; + Name : Name_Id; + Line, Col : Natural; + begin + Files_Map.Location_To_Position (Get_Location (Loc), Name, Line, Col); + + Start_Association (Constr, Ghdl_Direction_Check_Failed); + Assoc_Filename_Line (Constr, Line); + New_Procedure_Call (Constr); + end Gen_Direction_Error; + procedure Gen_Program_Error (Loc : Iir; Code : Natural) is Assoc : O_Assoc_List; @@ -92,6 +105,15 @@ package body Trans.Chap6 is Finish_If_Stmt (If_Blk); end Check_Bound_Error; + procedure Check_Direction_Error (Cond : O_Enode; Loc : Iir) + is + If_Blk : O_If_Block; + begin + Start_If_Stmt (If_Blk, Cond); + Gen_Direction_Error (Loc); + Finish_If_Stmt (If_Blk); + end Check_Direction_Error; + -- Return TRUE if an array whose index type is RNG_TYPE indexed by -- an expression of type EXPR_TYPE needs a bound check. function Need_Index_Check (Expr_Type : Iir; Rng_Type : Iir) @@ -586,12 +608,12 @@ package body Trans.Chap6 is or else Get_Kind (Prefix_Type) /= Iir_Kind_Array_Subtype_Definition then -- Check same direction. - Check_Bound_Error + Check_Direction_Error (New_Compare_Op (ON_Neq, - M2E (Chap3.Range_To_Dir (Prefix_Range)), - M2E (Chap3.Range_To_Dir (Slice_Range)), - Ghdl_Bool_Type), - Expr, 1); + M2E (Chap3.Range_To_Dir (Prefix_Range)), + M2E (Chap3.Range_To_Dir (Slice_Range)), + Ghdl_Bool_Type), + Expr); end if; Unsigned_Diff := Create_Temp (Ghdl_Index_Type); diff --git a/src/vhdl/translate/trans_decls.ads b/src/vhdl/translate/trans_decls.ads index 0a2d5e69f..d0011e653 100644 --- a/src/vhdl/translate/trans_decls.ads +++ b/src/vhdl/translate/trans_decls.ads @@ -168,7 +168,8 @@ package Trans_Decls is -- Procedure called in case of check failed. Ghdl_Program_Error : O_Dnode; - Ghdl_Bound_Check_Failed_L1 : O_Dnode; + Ghdl_Bound_Check_Failed : O_Dnode; + Ghdl_Direction_Check_Failed : O_Dnode; -- Stack 2. Ghdl_Stack2_Allocate : O_Dnode; diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb index 7c7e1904e..6baaaa995 100644 --- a/src/vhdl/translate/translation.adb +++ b/src/vhdl/translate/translation.adb @@ -601,22 +601,29 @@ package body Translation is Start_Procedure_Decl (Interfaces, Get_Identifier ("__ghdl_program_error"), O_Storage_External); - New_Interface_Decl - (Interfaces, Param, Wki_Filename, Char_Ptr_Type); - New_Interface_Decl - (Interfaces, Param, Wki_Line, Ghdl_I32_Type); + New_Interface_Decl (Interfaces, Param, Wki_Filename, Char_Ptr_Type); + New_Interface_Decl (Interfaces, Param, Wki_Line, Ghdl_I32_Type); New_Interface_Decl (Interfaces, Param, Get_Identifier ("code"), Ghdl_Index_Type); Finish_Subprogram_Decl (Interfaces, Ghdl_Program_Error); - -- procedure __ghdl_bound_check_failed_l1 (filename : char_ptr_type; - -- line : ghdl_i32); + -- procedure __ghdl_bound_check_failed (filename : char_ptr_type; + -- line : ghdl_i32); + Start_Procedure_Decl + (Interfaces, Get_Identifier ("__ghdl_bound_check_failed"), + O_Storage_External); + New_Interface_Decl (Interfaces, Param, Wki_Filename, Char_Ptr_Type); + New_Interface_Decl (Interfaces, Param, Wki_Line, Ghdl_I32_Type); + Finish_Subprogram_Decl (Interfaces, Ghdl_Bound_Check_Failed); + + -- procedure __ghdl_direction_check_failed (filename : char_ptr_type; + -- line : ghdl_i32); Start_Procedure_Decl - (Interfaces, Get_Identifier ("__ghdl_bound_check_failed_l1"), + (Interfaces, Get_Identifier ("__ghdl_direction_check_failed"), O_Storage_External); New_Interface_Decl (Interfaces, Param, Wki_Filename, Char_Ptr_Type); New_Interface_Decl (Interfaces, Param, Wki_Line, Ghdl_I32_Type); - Finish_Subprogram_Decl (Interfaces, Ghdl_Bound_Check_Failed_L1); + Finish_Subprogram_Decl (Interfaces, Ghdl_Direction_Check_Failed); -- Secondary stack subprograms. -- function __ghdl_stack2_allocate (size : ghdl_index_type) |