aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ghdldrv/ghdlrun.adb6
-rw-r--r--src/grt/grt-lib.adb19
-rw-r--r--src/grt/grt-lib.ads13
-rw-r--r--src/vhdl/translate/trans-chap6.adb34
-rw-r--r--src/vhdl/translate/trans_decls.ads3
-rw-r--r--src/vhdl/translate/translation.adb23
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)