From 5722f78e31550fe7d3b46fe8ac0e97617861af4b Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 18 Apr 2020 10:52:45 +0200 Subject: [PATCH 1/3] add a regression test for issue 9460 See . We currently expect this test to fail on 32bit systems, and succeed on 64bits systems. Contributed by Richard Jones. --- testsuite/tests/lib-int64/issue9460.ml | 37 +++++++++++++++++++ testsuite/tests/lib-int64/issue9460.reference | 1 + 2 files changed, 38 insertions(+) create mode 100644 testsuite/tests/lib-int64/issue9460.ml create mode 100644 testsuite/tests/lib-int64/issue9460.reference diff --git a/testsuite/tests/lib-int64/issue9460.ml b/testsuite/tests/lib-int64/issue9460.ml new file mode 100644 index 000000000..aacbe6189 --- /dev/null +++ b/testsuite/tests/lib-int64/issue9460.ml @@ -0,0 +1,37 @@ +(* TEST +*) + +(* See https://github.com/ocaml/ocaml/issues/9460 + This test comes from Richard Jones + at + https://github.com/libguestfs/libnbd/blob/0475bfe04a527051c0a37af59a733c4c8554e427/ocaml/tests/test_400_pread.ml#L21-L36 +*) +let test_result = + let b = Bytes.create 16 in + for i = 0 to 16/8-1 do + let i64 = ref (Int64.of_int (i*8)) in + for j = 0 to 7 do + let c = Int64.shift_right_logical !i64 56 in + let c = Int64.to_int c in + let c = Char.chr c in + Bytes.unsafe_set b (i*8+j) c; + i64 := Int64.shift_left !i64 8 + done + done; + (Bytes.to_string b) ;; + +let expected = + "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\008" + +let () = + assert (test_result = expected) + +(* Reproduction case by Jeremy Yallop in + https://github.com/ocaml/ocaml/pull/9463#issuecomment-615831765 +*) +let () = + let x = ref Int64.max_int in + assert (!x = Int64.max_int) + +let () = + print_endline "OK" diff --git a/testsuite/tests/lib-int64/issue9460.reference b/testsuite/tests/lib-int64/issue9460.reference new file mode 100644 index 000000000..d86bac9de --- /dev/null +++ b/testsuite/tests/lib-int64/issue9460.reference @@ -0,0 +1 @@ +OK From 8f006a366beb0932bf17293d8ffbf3a2522fe20b Mon Sep 17 00:00:00 2001 From: Vincent Laviron Date: Sat, 18 Apr 2020 10:53:25 +0200 Subject: [PATCH 2/3] Fix Cmm type of unboxed Int64 values in Clet_mut --- asmcomp/cmmgen.ml | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index 6e1c924dc..ec9697177 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -247,6 +247,11 @@ let box_int dbg bi arg = (* Boxed numbers *) +let typ_of_boxed_number = function + | Boxed_float _ -> Cmm.typ_float + | Boxed_integer (Pint64, _) when size_int = 4 -> [|Int;Int|] + | Boxed_integer _ -> Cmm.typ_int + let equal_unboxed_integer ui1 ui2 = match ui1, ui2 with | Pnativeint, Pnativeint -> true @@ -687,11 +692,6 @@ and transl_catch env nfail ids body handler dbg = in let env_body = add_notify_catch nfail report env in let body = transl env_body body in - let typ_of_bn = function - | Boxed_float _ -> Cmm.typ_float - | Boxed_integer (Pint64, _) when size_int = 4 -> [|Int;Int|] - | Boxed_integer _ -> Cmm.typ_int - in let new_env, rewrite, ids = List.fold_right (fun (id, _kind, u) (env, rewrite, ids) -> @@ -704,7 +704,7 @@ and transl_catch env nfail ids body handler dbg = let unboxed_id = V.create_local (VP.name id) in add_unboxed_id (VP.var id) unboxed_id bn env, (unbox_number Debuginfo.none bn) :: rewrite, - (VP.create unboxed_id, typ_of_bn bn) :: ids + (VP.create unboxed_id, typ_of_boxed_number bn) :: ids ) ids (env, [], []) in @@ -1165,8 +1165,7 @@ and transl_let env str kind id exp body = transl (add_unboxed_id (VP.var id) unboxed_id boxed_number env) body in begin match str, boxed_number with | Immutable, _ -> Clet (v, cexp, body) - | Mutable, Boxed_float _ -> Clet_mut (v, typ_float, cexp, body) - | Mutable, Boxed_integer _ -> Clet_mut (v, typ_int, cexp, body) + | Mutable, bn -> Clet_mut (v, typ_of_boxed_number bn, cexp, body) end and make_catch ncatch body handler dbg = match body with From 5c0e138bb4dcd3b098f3964a53034c76e09bc235 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 18 Apr 2020 11:43:09 +0200 Subject: [PATCH 3/3] Changes entry --- Changes | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/Changes b/Changes index 5076d2293..89f1fb92a 100644 --- a/Changes +++ b/Changes @@ -66,9 +66,10 @@ Working version - #9280: Micro-optimise allocations on amd64 to save a register. (Stephen Dolan, review by Xavier Leroy) -- #9316, #9443: Use typing information from Clambda for mutable Cmm variables. +- #9316, #9443, #9463: Use typing information from Clambda + for mutable Cmm variables. (Stephen Dolan, review by Vincent Laviron, Guillaume Bury, Xavier Leroy, - and Gabriel Scherer) + and Gabriel Scherer; temporary bug report by Richard Jones) - #9426: build the Mingw ports with higher levels of GCC optimization (Xavier Leroy, review by Sébastien Hinderer)