diff options
| -rw-r--r-- | Changes | 11 | ||||
| -rw-r--r-- | asmcomp/amd64/emit.mlp | 74 | ||||
| -rw-r--r-- | asmcomp/amd64/emit_nt.mlp | 74 | ||||
| -rw-r--r-- | asmcomp/amd64/reload.ml | 12 |
4 files changed, 103 insertions, 68 deletions
@@ -45,7 +45,6 @@ Language features: uses, this allows to merge two signatures containing identically named fields. - Compilers and toplevel: - Warnings are now numbered and can be switched on and off individually. The old system with letters referring to sets of warnings is still @@ -69,6 +68,10 @@ Compilers and toplevel: This option can help working around mysterious type incompatibilities caused by the incomplete comparison of applicative paths F(X).t. +Native-code compiler: +- AMD64: shorter and slightly more efficient code generated for + float comparisons. + Standard library: - Format: new function ikfprintf analoguous to ifprintf with a continuation argument. @@ -89,6 +92,12 @@ Other libraries: Ocamlbuild: - Add support for native dynlink. +New tool: +- ocamlobjinfo: displays various information, esp. dependencies, for + compiled OCaml files (.cmi, .cmo, .cma, .cmx, .cmxa, .cmxs, and bytecode + executables). Extends and makes more official the old objinfo tool + that was installed by some OCaml packages. + All tools: - PR#4857: add a -vnum option to display the version number and nothing else diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp index b1f886da9..d9dd162eb 100644 --- a/asmcomp/amd64/emit.mlp +++ b/asmcomp/amd64/emit.mlp @@ -270,40 +270,50 @@ let output_test_zero arg = (* Output a floating-point compare and branch *) let emit_float_test cmp neg arg lbl = - begin match cmp with - | Ceq | Cne -> ` ucomisd ` - | _ -> ` comisd ` - end; - `{emit_reg arg.(1)}, {emit_reg arg.(0)}\n`; - let (branch_opcode, need_jp) = - match (cmp, neg) with - (Ceq, false) -> ("je", true) - | (Ceq, true) -> ("jne", true) - | (Cne, false) -> ("jne", true) - | (Cne, true) -> ("je", true) - | (Clt, false) -> ("jb", true) - | (Clt, true) -> ("jae", true) - | (Cle, false) -> ("jbe", true) - | (Cle, true) -> ("ja", true) - | (Cgt, false) -> ("ja", false) - | (Cgt, true) -> ("jbe", false) - | (Cge, false) -> ("jae", true) - | (Cge, true) -> ("jb", false) in - let branch_if_not_comparable = - if cmp = Cne then not neg else neg in - if need_jp then - if branch_if_not_comparable then begin - ` jp {emit_label lbl}\n`; - ` {emit_string branch_opcode} {emit_label lbl}\n` - end else begin + (* Effect of comisd on flags and conditional branches: + ZF PF CF cond. branches taken + unordered 1 1 1 je, jb, jbe, jp + > 0 0 0 jne, jae, ja + < 0 0 1 jne, jbe, jb + = 1 0 0 je, jae, jbe. + If FP traps are on (they are off by default), + comisd traps on QNaN and SNaN but ucomisd traps on SNaN only. + *) + match (cmp, neg) with + | (Ceq, false) | (Cne, true) -> let next = new_label() in - ` jp {emit_label next}\n`; - ` {emit_string branch_opcode} {emit_label lbl}\n`; + ` ucomisd {emit_reg arg.(1)}, {emit_reg arg.(0)}\n`; + ` jp {emit_label next}\n`; (* skip if unordered *) + ` je {emit_label lbl}\n`; (* branch taken if x=y *) `{emit_label next}:\n` - end - else begin - ` {emit_string branch_opcode} {emit_label lbl}\n` - end + | (Cne, false) | (Ceq, true) -> + ` ucomisd {emit_reg arg.(1)}, {emit_reg arg.(0)}\n`; + ` jp {emit_label lbl}\n`; (* branch taken if unordered *) + ` jne {emit_label lbl}\n` (* branch taken if x<y or x>y *) + | (Clt, _) -> + ` comisd {emit_reg arg.(0)}, {emit_reg arg.(1)}\n`; (* swap compare *) + if not neg then + ` ja {emit_label lbl}\n` (* branch taken if y>x i.e. x<y *) + else + ` jbe {emit_label lbl}\n` (* taken if unordered or y<=x i.e. !(x<y) *) + | (Cle, _) -> + ` comisd {emit_reg arg.(0)}, {emit_reg arg.(1)}\n`; (* swap compare *) + if not neg then + ` jae {emit_label lbl}\n` (* branch taken if y>=x i.e. x<=y *) + else + ` jb {emit_label lbl}\n` (* taken if unordered or y<x i.e. !(x<=y) *) + | (Cgt, _) -> + ` comisd {emit_reg arg.(1)}, {emit_reg arg.(0)}\n`; + if not neg then + ` ja {emit_label lbl}\n` (* branch taken if x>y *) + else + ` jbe {emit_label lbl}\n` (* taken if unordered or x<=y i.e. !(x>y) *) + | (Cge, _) -> + ` comisd {emit_reg arg.(1)}, {emit_reg arg.(0)}\n`; (* swap compare *) + if not neg then + ` jae {emit_label lbl}\n` (* branch taken if x>=y *) + else + ` jb {emit_label lbl}\n` (* taken if unordered or x<y i.e. !(x>=y) *) (* Deallocate the stack frame before a return or tail call *) diff --git a/asmcomp/amd64/emit_nt.mlp b/asmcomp/amd64/emit_nt.mlp index 23c5b34ec..3374f4d36 100644 --- a/asmcomp/amd64/emit_nt.mlp +++ b/asmcomp/amd64/emit_nt.mlp @@ -264,40 +264,50 @@ let output_test_zero arg = (* Output a floating-point compare and branch *) let emit_float_test cmp neg arg lbl = - begin match cmp with - | Ceq | Cne -> ` ucomisd ` - | _ -> ` comisd ` - end; - `{emit_reg arg.(0)}, {emit_reg arg.(1)}\n`; - let (branch_opcode, need_jp) = - match (cmp, neg) with - (Ceq, false) -> ("je", true) - | (Ceq, true) -> ("jne", true) - | (Cne, false) -> ("jne", true) - | (Cne, true) -> ("je", true) - | (Clt, false) -> ("jb", true) - | (Clt, true) -> ("jae", true) - | (Cle, false) -> ("jbe", true) - | (Cle, true) -> ("ja", true) - | (Cgt, false) -> ("ja", false) - | (Cgt, true) -> ("jbe", false) - | (Cge, false) -> ("jae", true) - | (Cge, true) -> ("jb", false) in - let branch_if_not_comparable = - if cmp = Cne then not neg else neg in - if need_jp then - if branch_if_not_comparable then begin - ` jp {emit_label lbl}\n`; - ` {emit_string branch_opcode} {emit_label lbl}\n` - end else begin + (* Effect of comisd on flags and conditional branches: + ZF PF CF cond. branches taken + unordered 1 1 1 je, jb, jbe, jp + > 0 0 0 jne, jae, ja + < 0 0 1 jne, jbe, jb + = 1 0 0 je, jae, jbe. + If FP traps are on (they are off by default), + comisd traps on QNaN and SNaN but ucomisd traps on SNaN only. + *) + match (cmp, neg) with + | (Ceq, false) | (Cne, true) -> let next = new_label() in - ` jp {emit_label next}\n`; - ` {emit_string branch_opcode} {emit_label lbl}\n`; + ` ucomisd {emit_reg arg.(0)}, {emit_reg arg.(1)}\n`; + ` jp {emit_label next}\n`; (* skip if unordered *) + ` je {emit_label lbl}\n`; (* branch taken if x=y *) `{emit_label next}:\n` - end - else begin - ` {emit_string branch_opcode} {emit_label lbl}\n` - end + | (Cne, false) | (Ceq, true) -> + ` ucomisd {emit_reg arg.(0)}, {emit_reg arg.(1)}\n`; + ` jp {emit_label lbl}\n`; (* branch taken if unordered *) + ` jne {emit_label lbl}\n` (* branch taken if x<y or x>y *) + | (Clt, _) -> + ` comisd {emit_reg arg.(1)}, {emit_reg arg.(0)}\n`; (* swap compare *) + if not neg then + ` ja {emit_label lbl}\n` (* branch taken if y>x i.e. x<y *) + else + ` jbe {emit_label lbl}\n` (* taken if unordered or y<=x i.e. !(x<y) *) + | (Cle, _) -> + ` comisd {emit_reg arg.(1)}, {emit_reg arg.(0)}\n`; (* swap compare *) + if not neg then + ` jae {emit_label lbl}\n` (* branch taken if y>=x i.e. x<=y *) + else + ` jb {emit_label lbl}\n` (* taken if unordered or y<x i.e. !(x<=y) *) + | (Cgt, _) -> + ` comisd {emit_reg arg.(0)}, {emit_reg arg.(1)}\n`; + if not neg then + ` ja {emit_label lbl}\n` (* branch taken if x>y *) + else + ` jbe {emit_label lbl}\n` (* taken if unordered or x<=y i.e. !(x>y) *) + | (Cge, _) -> + ` comisd {emit_reg arg.(0)}, {emit_reg arg.(1)}\n`; (* swap compare *) + if not neg then + ` jae {emit_label lbl}\n` (* branch taken if x>=y *) + else + ` jb {emit_label lbl}\n` (* taken if unordered or x<y i.e. !(x>=y) *) (* Deallocate the stack frame before a return or tail call *) diff --git a/asmcomp/amd64/reload.ml b/asmcomp/amd64/reload.ml index 50b962f89..66772de97 100644 --- a/asmcomp/amd64/reload.ml +++ b/asmcomp/amd64/reload.ml @@ -49,7 +49,7 @@ open Mach Conditional branches: Iinttest S R or R S - Ifloattest R S + Ifloattest R S (or S R if swapped test) other tests S *) @@ -64,7 +64,7 @@ inherit Reloadgen.reload_generic as super method! reload_operation op arg res = match op with - Iintop(Iadd|Isub|Iand|Ior|Ixor|Icomp _|Icheckbound) -> + | Iintop(Iadd|Isub|Iand|Ior|Ixor|Icomp _|Icheckbound) -> (* One of the two arguments can reside in the stack, but not both *) if stackp arg.(0) && stackp arg.(1) then ([|arg.(0); self#makereg arg.(1)|], res) @@ -106,7 +106,13 @@ method! reload_test tst arg = if stackp arg.(0) && stackp arg.(1) then [| self#makereg arg.(0); arg.(1) |] else arg - | Ifloattest(_, _) -> + | Ifloattest((Clt|Cle), _) -> + (* Cf. emit.mlp: we swap arguments in this case *) + (* First argument can be on stack, second must be in register *) + if stackp arg.(1) + then [| arg.(0); self#makereg arg.(1) |] + else arg + | Ifloattest((Ceq|Cne|Cgt|Cge), _) -> (* Second argument can be on stack, first must be in register *) if stackp arg.(0) then [| self#makereg arg.(0); arg.(1) |] |