diff options
| -rw-r--r-- | doc/using/Simulation.rst | 5 | ||||
| -rw-r--r-- | src/ghdldrv/ghdlrun.adb | 2 | ||||
| -rw-r--r-- | src/grt/grt-lib.adb | 13 | ||||
| -rw-r--r-- | src/grt/grt-lib.ads | 8 | ||||
| -rw-r--r-- | src/grt/grt-options.adb | 16 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap4.adb | 46 | ||||
| -rw-r--r-- | src/vhdl/translate/trans.ads | 2 | ||||
| -rw-r--r-- | src/vhdl/translate/trans_decls.ads | 2 | ||||
| -rw-r--r-- | src/vhdl/translate/translation.adb | 15 | ||||
| -rw-r--r-- | src/vhdl/translate/translation.ads | 4 |
10 files changed, 112 insertions, 1 deletions
diff --git a/doc/using/Simulation.rst b/doc/using/Simulation.rst index 221e0a093..6b6ea6a1a 100644 --- a/doc/using/Simulation.rst +++ b/doc/using/Simulation.rst @@ -82,6 +82,11 @@ all options available, including the debugging one. Disable buffering on stdout, stderr and files opened in write or append mode (TEXTIO). +.. option:: --max-stack-alloc<=N> + + Emit an error message in case of allocation on the stack of an + object larger than `N` KB. + .. option:: --sdf<=PATH=FILENAME> Do VITAL annotation on `PATH` with SDF file :file:`FILENAME`. diff --git a/src/ghdldrv/ghdlrun.adb b/src/ghdldrv/ghdlrun.adb index 9d1e14343..c4d9cc3be 100644 --- a/src/ghdldrv/ghdlrun.adb +++ b/src/ghdldrv/ghdlrun.adb @@ -322,6 +322,8 @@ package body Ghdlrun is Grt.Lib.Ghdl_I32_Exp'Address); Def (Trans_Decls.Ghdl_I64_Exp, Grt.Lib.Ghdl_I64_Exp'Address); + Def (Trans_Decls.Ghdl_Check_Stack_Allocation, + Grt.Lib.Ghdl_Check_Stack_Allocation'Address); Def (Trans_Decls.Ghdl_Sensitized_Process_Register, Grt.Processes.Ghdl_Sensitized_Process_Register'Address); diff --git a/src/grt/grt-lib.adb b/src/grt/grt-lib.adb index 7597bcfc4..0bb9c2e36 100644 --- a/src/grt/grt-lib.adb +++ b/src/grt/grt-lib.adb @@ -275,6 +275,19 @@ package body Grt.Lib is return Ghdl_I64_Exp_1 (V, E); end Ghdl_I64_Exp; + procedure Ghdl_Check_Stack_Allocation (Size : Ghdl_Index_Type) + is + Bt : Backtrace_Addrs; + begin + if Size >= Max_Stack_Allocation then + Save_Backtrace (Bt, 1); + Error_S ("declaration of a too large object ("); + Diag_C (Natural (Size / 1024)); + Diag_C (" KB)"); + Error_E_Call_Stack (Bt); + end if; + end Ghdl_Check_Stack_Allocation; + function C_Malloc (Size : Ghdl_Index_Type) return Ghdl_Ptr; pragma Import (C, C_Malloc, "malloc"); diff --git a/src/grt/grt-lib.ads b/src/grt/grt-lib.ads index 646cdd5fb..167ea98e5 100644 --- a/src/grt/grt-lib.ads +++ b/src/grt/grt-lib.ads @@ -70,6 +70,11 @@ package Grt.Lib is function Ghdl_I32_Exp (V : Ghdl_I32; E : Std_Integer) return Ghdl_I32; function Ghdl_I64_Exp (V : Ghdl_I64; E : Std_Integer) return Ghdl_I64; + -- Called before allocation of large (complex) objects. + procedure Ghdl_Check_Stack_Allocation (Size : Ghdl_Index_Type); + + Max_Stack_Allocation : Ghdl_Index_Type := 128 * 1024; + function Ghdl_Malloc (Size : Ghdl_Index_Type) return Ghdl_Ptr; -- Allocate and clear SIZE bytes. @@ -122,6 +127,9 @@ private "__ghdl_direction_check_failed"); pragma Export (C, Ghdl_Program_Error, "__ghdl_program_error"); + pragma Export (C, Ghdl_Check_Stack_Allocation, + "__ghdl_check_stack_allocation"); + pragma Export (C, Ghdl_Malloc, "__ghdl_malloc"); pragma Export (C, Ghdl_Malloc0, "__ghdl_malloc0"); pragma Export (C, Ghdl_Deallocate, "__ghdl_deallocate"); diff --git a/src/grt/grt-options.adb b/src/grt/grt-options.adb index 5b154e4a5..d93ad9e58 100644 --- a/src/grt/grt-options.adb +++ b/src/grt/grt-options.adb @@ -56,6 +56,7 @@ package body Grt.Options is P (" X is expressed as a time value, without spaces: 1ns, ps..."); P (" --stop-delta=X stop the simulation cycle after X delta"); P (" --expect-failure invert exit status"); + P (" --max-stack-alloc=X error if variables are larger than X KB"); P (" --no-run do not simulate, only elaborate"); P (" --unbuffered disable buffering on stdout, stderr and"); P (" files opened in write or append mode (TEXTIO)."); @@ -272,6 +273,21 @@ package body Grt.Options is Warning ("option --stack-size is deprecated"); elsif Len >= 17 and then Option (1 .. 17) = "--stack-max-size=" then Warning ("option --stack-max-size is deprecated"); + elsif Len >= 18 and then Option (1 .. 18) = "--max-stack-alloc=" then + declare + Ok : Boolean; + Pos : Natural; + Val : Integer_64; + begin + Extract_Integer (Option (19 .. Len), Ok, Val, Pos); + if not Ok or else Pos <= Len then + Error_S ("bad value in '"); + Diag_C (Option); + Error_E ("'"); + else + Lib.Max_Stack_Allocation := Ghdl_Index_Type (Val * 1024); + end if; + end; elsif Len >= 11 and then Option (1 .. 11) = "--activity=" then if Option (12 .. Len) = "none" then Flag_Activity := Activity_None; diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb index 73f8aa4e1..675dc3d62 100644 --- a/src/vhdl/translate/trans-chap4.adb +++ b/src/vhdl/translate/trans-chap4.adb @@ -447,6 +447,40 @@ package body Trans.Chap4 is end case; end Init_Object; + -- If SIZE is larger than the threshold, call __ghdl_check_stack_allocation + -- to raise an error if the size is too large. There are two threshold: + -- one set at compile time (Check_Stack_Allocation_Threshold) and one set + -- at run-time. + -- + -- Right now, this function is called only for allocation of a complex + -- object on the stack (constant or variable). But there are more sources + -- of stack allocation (temporary aggregate, unbounded objects, individual + -- assocs...) + function Maybe_Check_Stack_Allocation (Size : O_Enode) return O_Enode + is + Val : O_Dnode; + If_Blk : O_If_Block; + Assoc : O_Assoc_List; + begin + if Flag_Check_Stack_Allocation = 0 then + return Size; + end if; + + Val := Create_Temp_Init (Ghdl_Index_Type, Size); + Start_If_Stmt + (If_Blk, + New_Compare_Op (ON_Ge, + New_Obj_Value (Val), + New_Lit (Check_Stack_Allocation_Threshold), + Ghdl_Bool_Type)); + Start_Association (Assoc, Ghdl_Check_Stack_Allocation); + New_Association (Assoc, New_Obj_Value (Val)); + New_Procedure_Call (Assoc); + Finish_If_Stmt (If_Blk); + + return New_Obj_Value (Val); + end Maybe_Check_Stack_Allocation; + procedure Elab_Object_Storage (Obj : Iir) is Obj_Type : constant Iir := Get_Type (Obj); @@ -456,6 +490,7 @@ package body Trans.Chap4 is Type_Info : Type_Info_Acc; Alloc_Kind : Allocation_Kind; + Size : O_Enode; begin -- Elaborate subtype. Chap3.Elab_Object_Subtype (Obj_Type); @@ -476,7 +511,16 @@ package body Trans.Chap4 is -- the object is a constant Name_Node := Get_Var (Obj_Info.Object_Var, Type_Info, Mode_Value); Alloc_Kind := Get_Alloc_Kind_For_Var (Obj_Info.Object_Var); - Allocate_Complex_Object (Obj_Type, Alloc_Kind, Name_Node); + Size := Chap3.Get_Subtype_Size (Obj_Type, Mnode_Null, Mode_Value); + if Alloc_Kind = Alloc_Stack then + Size := Maybe_Check_Stack_Allocation (Size); + end if; + -- Was: Allocate_Complex_Object. + New_Assign_Stmt + (M2Lp (Name_Node), + Gen_Alloc (Alloc_Kind, + Size, + Type_Info.Ortho_Ptr_Type (Mode_Value))); end if; end Elab_Object_Storage; diff --git a/src/vhdl/translate/trans.ads b/src/vhdl/translate/trans.ads index f154d6d5d..aa6102e5c 100644 --- a/src/vhdl/translate/trans.ads +++ b/src/vhdl/translate/trans.ads @@ -138,6 +138,8 @@ package Trans is Ghdl_Signal_Ptr : O_Tnode; Ghdl_Signal_Ptr_Ptr : O_Tnode; + Check_Stack_Allocation_Threshold : O_Cnode; + type Object_Kind_Type is (Mode_Value, Mode_Signal); -- Well known identifiers. diff --git a/src/vhdl/translate/trans_decls.ads b/src/vhdl/translate/trans_decls.ads index 2f9fa539a..38d3be7e7 100644 --- a/src/vhdl/translate/trans_decls.ads +++ b/src/vhdl/translate/trans_decls.ads @@ -23,6 +23,8 @@ package Trans_Decls is Ghdl_Ieee_Assert_Failed : O_Dnode; Ghdl_Psl_Assert_Failed : O_Dnode; + Ghdl_Check_Stack_Allocation : O_Dnode; + Ghdl_Psl_Cover : O_Dnode; Ghdl_Psl_Cover_Failed : O_Dnode; -- Procedure for report statement. diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb index 2edeba0be..0999e792e 100644 --- a/src/vhdl/translate/translation.adb +++ b/src/vhdl/translate/translation.adb @@ -15,6 +15,7 @@ -- along with GCC; see the file COPYING. If not, write to the Free -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. +with Interfaces; use Interfaces; with Ortho_Nodes; use Ortho_Nodes; with Ortho_Ident; use Ortho_Ident; with Flags; use Flags; @@ -1079,6 +1080,20 @@ package body Translation is Create_Report_Subprg ("__ghdl_report", Ghdl_Report); end; + -- procedure __ghdl_check_stack_allocation (size : __ghdl_index_type) + Start_Procedure_Decl + (Interfaces, Get_Identifier ("__ghdl_check_stack_allocation"), + O_Storage_External); + New_Interface_Decl (Interfaces, Param, Wki_Val, Ghdl_Index_Type); + Finish_Subprogram_Decl (Interfaces, Ghdl_Check_Stack_Allocation); + + if Flag_Check_Stack_Allocation > 0 then + Check_Stack_Allocation_Threshold := + New_Index_Lit (Unsigned_64 (Flag_Check_Stack_Allocation)); + else + Check_Stack_Allocation_Threshold := O_Cnode_Null; + end if; + -- procedure __ghdl_text_write (file : __ghdl_file_index; -- str : std_string_ptr); Start_Procedure_Decl diff --git a/src/vhdl/translate/translation.ads b/src/vhdl/translate/translation.ads index 4c9b2ff27..ffaabd3bf 100644 --- a/src/vhdl/translate/translation.ads +++ b/src/vhdl/translate/translation.ads @@ -80,6 +80,10 @@ package Translation is -- support nested subprograms. Flag_Unnest_Subprograms : Boolean := False; + -- If > 0, emit a call for large dynamic allocation on the stack. Large + -- defined by the value. + Flag_Check_Stack_Allocation : Natural := 32 * 1024; + type Foreign_Kind_Type is (Foreign_Unknown, Foreign_Vhpidirect, Foreign_Intrinsic); |