Sign Up
Log In
Log In
or
Sign Up
Places
All Projects
Status Monitor
Collapse sidebar
SUSE:SLE-15-SP5:GA
ocaml
ocaml-Fixes-for-out-of-range-Ialloc.patch
Overview
Repositories
Revisions
Requests
Users
Attributes
Meta
File ocaml-Fixes-for-out-of-range-Ialloc.patch of Package ocaml
From 664f0763d37f85e2ec53d6394251b5948dcfa727 Mon Sep 17 00:00:00 2001 From: Mark Shinwell <mshinwell@janestreet.com> Date: Mon, 31 Jul 2017 14:37:47 +0100 Subject: Fixes for out-of-range Ialloc Cherry-pick of GPR#1271 which was merged on trunk. Fixes for Ialloc instructions allocating more than Max_young_wosize words in the minor heap Out-of-range Ialloc instructions cause various problems, see in particular GPR #1250. --- Changes | 5 + asmcomp/cmmgen.ml | 38 ++-- asmcomp/selectgen.ml | 3 +- testsuite/tests/basic-more/pr1271.ml | 288 ++++++++++++++++++++++++++++ testsuite/tests/basic-more/pr1271.reference | 2 + 5 files changed, 317 insertions(+), 19 deletions(-) create mode 100644 testsuite/tests/basic-more/pr1271.ml create mode 100644 testsuite/tests/basic-more/pr1271.reference diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index 4ac4b40c6..2120d3985 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -1641,29 +1641,31 @@ let rec transl env e = List.iter (fun f -> Queue.add f functions) fundecls; Cconst_symbol lbl | Uclosure(fundecls, clos_vars) -> - let block_size = - fundecls_size fundecls + List.length clos_vars in let rec transl_fundecls pos = function [] -> List.map (transl env) clos_vars | f :: rem -> Queue.add f functions; - let header = - if pos = 0 - then alloc_closure_header block_size f.dbg - else alloc_infix_header pos f.dbg in - if f.arity = 1 || f.arity = 0 then - header :: - Cconst_symbol f.label :: - int_const f.arity :: - transl_fundecls (pos + 3) rem - else - header :: - Cconst_symbol(curry_function f.arity) :: - int_const f.arity :: - Cconst_symbol f.label :: - transl_fundecls (pos + 4) rem in - Cop(Calloc, transl_fundecls 0 fundecls, Debuginfo.none) + let without_header = + if f.arity = 1 || f.arity = 0 then + Cconst_symbol f.label :: + int_const f.arity :: + transl_fundecls (pos + 3) rem + else + Cconst_symbol(curry_function f.arity) :: + int_const f.arity :: + Cconst_symbol f.label :: + transl_fundecls (pos + 4) rem + in + if pos = 0 then without_header + else (alloc_infix_header pos f.dbg) :: without_header + in + let dbg = + match fundecls with + | [] -> Debuginfo.none + | fundecl::_ -> fundecl.dbg + in + make_alloc dbg Obj.closure_tag (transl_fundecls 0 fundecls) | Uoffset(arg, offset) -> (* produces a valid Caml value, pointing just after an infix header *) let ptr = transl env arg in diff --git a/asmcomp/selectgen.ml b/asmcomp/selectgen.ml index 7cd8cd5c3..1158fc0d0 100644 --- a/asmcomp/selectgen.ml +++ b/asmcomp/selectgen.ml @@ -738,7 +738,8 @@ method emit_expr (env:environment) exp = loc_arg (Proc.loc_external_results rd) in self#insert_move_results loc_res rd stack_ofs; Some rd - | Ialloc { words = _; spacetime_index; label_after_call_gc; } -> + | Ialloc { words; spacetime_index; label_after_call_gc; } -> + assert (words <= Config.max_young_wosize); let rd = self#regs_for typ_val in let size = size_expr env (Ctuple new_args) in let op =
Locations
Projects
Search
Status Monitor
Help
OpenBuildService.org
Documentation
API Documentation
Code of Conduct
Contact
Support
@OBShq
Terms
openSUSE Build Service is sponsored by
The Open Build Service is an
openSUSE project
.
Sign Up
Log In
Places
Places
All Projects
Status Monitor