From ff0d2345da9056f2b3496ab6cc093e4405b38319 Mon Sep 17 00:00:00 2001 From: alainfrisch Date: Mon, 11 Jul 2016 11:57:08 +0200 Subject: [PATCH] Hacks so that check_all_arches works even with a 32-bit compiler. --- asmcomp/amd64/selection.ml | 6 ++++-- asmcomp/s390x/emit.mlp | 2 +- asmcomp/s390x/selection.ml | 10 ++++++---- 3 files changed, 11 insertions(+), 7 deletions(-) diff --git a/asmcomp/amd64/selection.ml b/asmcomp/amd64/selection.ml index d90d86a61..1ee991d12 100644 --- a/asmcomp/amd64/selection.ml +++ b/asmcomp/amd64/selection.ml @@ -125,7 +125,9 @@ class selector = object (self) inherit Selectgen.selector_generic as super -method is_immediate n = n <= 0x7FFFFFFF && n >= -0x80000000 +method is_immediate n = n <= 0x7FFF_FFFF && n >= (-1-0x7FFF_FFFF) + (* -1-.... : hack so that this can be compiled on 32-bit + (cf 'make check_all_arches') *) method is_immediate_natint n = n <= 0x7FFFFFFFn && n >= -0x80000000n @@ -141,7 +143,7 @@ method! is_simple_expr e = method select_addressing _chunk exp = let (a, d) = select_addr exp in (* PR#4625: displacement must be a signed 32-bit immediate *) - if d < -0x8000_0000 || d > 0x7FFF_FFFF + if not (self # is_immediate d) then (Iindexed 0, exp) else match a with | Asymbol s -> diff --git a/asmcomp/s390x/emit.mlp b/asmcomp/s390x/emit.mlp index 9395f571d..eda64c010 100644 --- a/asmcomp/s390x/emit.mlp +++ b/asmcomp/s390x/emit.mlp @@ -504,7 +504,7 @@ let emit_instr i = ` srag {emit_reg i.res.(0)}, {emit_reg i.arg.(0)},{emit_int n}(%r0)\n` | Lop(Iintop_imm(Iand, n)) -> assert (i.arg.(0).loc = i.res.(0).loc); - ` nilf {emit_reg i.res.(0)}, {emit_int (n land 0xFFFF_FFFF)}\n` + ` nilf {emit_reg i.res.(0)}, {emit_int (n land (1 lsl 32 - 1)(*0xFFFF_FFFF*))}\n` | Lop(Iintop_imm(Ior, n)) -> assert (i.arg.(0).loc = i.res.(0).loc); ` oilf {emit_reg i.res.(0)}, {emit_int n}\n` diff --git a/asmcomp/s390x/selection.ml b/asmcomp/s390x/selection.ml index 7ef66a1d5..6561fd2c7 100644 --- a/asmcomp/s390x/selection.ml +++ b/asmcomp/s390x/selection.ml @@ -62,7 +62,9 @@ class selector = object (self) inherit Selectgen.selector_generic as super -method is_immediate n = (n <= 2147483647) && (n >= -2147483648) +method is_immediate n = n <= 0x7FFF_FFFF && n >= (-1-0x7FFF_FFFF) + (* -1-.... : hack so that this can be compiled on 32-bit + (cf 'make check_all_arches') *) method select_addressing _chunk exp = let (a, d) = select_addr exp in @@ -80,9 +82,9 @@ method! select_operation op args = (Cmulhi, _) -> (Iintop Imulh, args) (* The and, or and xor instructions have a different range of immediate operands than the other instructions *) - | (Cand, _) -> self#select_logical Iand (-0x1_0000_0000) (-1) args - | (Cor, _) -> self#select_logical Ior 0 0xFFFF_FFFF args - | (Cxor, _) -> self#select_logical Ixor 0 0xFFFF_FFFF args + | (Cand, _) -> self#select_logical Iand (-1 lsl 32 (*0x1_0000_0000*)) (-1) args + | (Cor, _) -> self#select_logical Ior 0 (1 lsl 32 - 1 (*0xFFFF_FFFF*)) args + | (Cxor, _) -> self#select_logical Ixor 0 (1 lsl 32 - 1 (*0xFFFF_FFFF*)) args (* Recognize mult-add and mult-sub instructions *) | (Caddf, [Cop(Cmulf, [arg1; arg2]); arg3]) -> (Ispecific Imultaddf, [arg1; arg2; arg3])