Skip to content

Commit eda1b39

Browse files
jhjourdandamiendoligez
jhjourdan
authored and
damiendoligez
committed
Fix mantis PR 7168 by creating a safety margin in the bytecode stack.
1 parent 9c05581 commit eda1b39

6 files changed

Lines changed: 90 additions & 3 deletions

File tree

‎Changes‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -188,6 +188,9 @@ Compilers:
188188
metadata generation. Was a cause of crashes in GUI programs on OS X.
189189
(Bart Jacobs, review by Mark Shinwell)
190190

191+
- PR#7168: Exceeding stack limit in bytecode can lead to a crash.
192+
(Jacques-Henri Jourdan)
193+
191194
- GPR#17: some cmm optimizations of integer operations with constants
192195
(Stephen Dolan, review by Pierre Chambart)
193196

‎bytecomp/bytegen.ml‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -906,9 +906,9 @@ and comp_binary_test env cond ifso ifnot sz cont =
906906
let comp_block env exp sz cont =
907907
max_stack_used := 0;
908908
let code = comp_expr env exp sz cont in
909-
(* +1 because comp_expr may have pushed one more word *)
910-
if !max_stack_used + 1 > Config.stack_threshold then
911-
Kconst(Const_base(Const_int(!max_stack_used + 1))) ::
909+
let used_safe = !max_stack_used + Config.stack_safety_margin in
910+
if used_safe > Config.stack_threshold then
911+
Kconst(Const_base(Const_int used_safe)) ::
912912
Kccall("caml_ensure_stack_capacity", 1) ::
913913
code
914914
else

‎testsuite/tests/misc/pr7168.ml‎

Lines changed: 77 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,77 @@
1+
let rec f x =
2+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
3+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
4+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
5+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
6+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
7+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
8+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
9+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
10+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
11+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
12+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
13+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
14+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
15+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
16+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
17+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
18+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
19+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
20+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
21+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
22+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
23+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
24+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
25+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
26+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
27+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
28+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
29+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
30+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
31+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
32+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
33+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
34+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
35+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
36+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
37+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
38+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
39+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
40+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
41+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
42+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
43+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
44+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
45+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
46+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
47+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
48+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
49+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
50+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
51+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
52+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
53+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
54+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
55+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
56+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
57+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
58+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
59+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
60+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
61+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
62+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
63+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
64+
let x = x+x in let x = x+x in let x = x+x in let x = x+x in
65+
let x = x+x in
66+
let _ = f x in
67+
()
68+
69+
let _ =
70+
if (Gc.get ()).Gc.stack_limit = 0 then begin
71+
(* We are in native code. Skip the test because some platforms cannot
72+
reliably detect stack overflow. *)
73+
Printf.printf "OK\n"
74+
end else begin
75+
try f 1
76+
with Stack_overflow -> Printf.printf "OK\n"
77+
end

‎testsuite/tests/misc/pr7168.reference‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
OK

‎utils/config.mli‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -90,6 +90,11 @@ val max_young_wosize: int
9090
val stack_threshold: int
9191
(* Size in words of safe area at bottom of VM stack,
9292
see byterun/config.h *)
93+
val stack_safety_margin: int
94+
(* Size in words of the safety margin between the bottom of
95+
the stack and the stack pointer. This margin can be used by
96+
intermediate computations of some instructions, or the event
97+
handler. *)
9398

9499
val architecture: string
95100
(* Name of processor type for the native-code compiler *)

‎utils/config.mlp‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -99,6 +99,7 @@ let lazy_tag = 246
9999

100100
let max_young_wosize = 256
101101
let stack_threshold = 256 (* see byterun/config.h *)
102+
let stack_safety_margin = 60
102103

103104
let architecture = "%%ARCH%%"
104105
let model = "%%MODEL%%"

0 commit comments

Comments
 (0)