1 files changed, 22 insertions, 23 deletions
diff --git a/kernel/vmemitcodes.ml b/kernel/vmemitcodes.ml
index babc57794b..c1d8fcb855 100644
--- a/kernel/vmemitcodes.ml
+++ b/kernel/vmemitcodes.ml
@@ -208,14 +208,6 @@ let slot_for_caml_prim env op =
 
 (* Emission of one instruction *)
 
-let nocheck_prim_op = function
-  | Int63add -> opADDINT63
-  | Int63sub -> opSUBINT63
-  | Int63lt  -> opLTINT63
-  | Int63le  -> opLEINT63
-  | _ -> assert false
-
-
 let check_prim_op = function
   | Int63head0     -> opCHECKHEAD0INT63
   | Int63tail0     -> opCHECKTAIL0INT63
@@ -259,11 +251,20 @@ let check_prim_op = function
   | Float64ldshiftexp -> opCHECKLDSHIFTEXP
   | Float64next_up    -> opCHECKNEXTUPFLOAT
   | Float64next_down  -> opCHECKNEXTDOWNFLOAT
-  | Arraymake -> opISINT_CAML_CALL2
-  | Arrayget -> opISARRAY_INT_CAML_CALL2
-  | Arrayset -> opISARRAY_INT_CAML_CALL3
+  | Arraymake -> opCHECKCAMLCALL2_1
+  | Arrayget -> opCHECKCAMLCALL2
+  | Arrayset -> opCHECKCAMLCALL3_1
   | Arraydefault | Arraycopy | Arraylength ->
-      opISARRAY_CAML_CALL1
+      opCHECKCAMLCALL1
+
+let inplace_prim_op = function
+  | Float64next_up | Float64next_down -> true
+  | _ -> false
+
+let check_prim_op_inplace = function
+  | Float64next_up   -> opCHECKNEXTUPFLOATINPLACE
+  | Float64next_down -> opCHECKNEXTDOWNFLOATINPLACE
+  | _ -> assert false
 
 let emit_instr env = function
   | Klabel lbl -> define_label env lbl
@@ -354,10 +355,7 @@ let emit_instr env = function
   | Kproj p -> out env opPROJ; out_int env (Projection.Repr.arg p); slot_for_proj_name env p
   | Kensurestackcapacity size -> out env opENSURESTACKCAPACITY; out_int env size
   | Kbranch lbl -> out env opBRANCH; out_label env lbl
-  | Kprim (op,None) ->
-      out env (nocheck_prim_op op)
-
-  | Kprim(op,Some (q,_u)) ->
+  | Kprim (op, (q,_u)) ->
       out env (check_prim_op op);
       slot_for_getglobal env q
 
@@ -366,13 +364,8 @@ let emit_instr env = function
     out_label env lbl;
     slot_for_caml_prim env op
 
-  | Kareint 1 -> out env opISINT
-  | Kareint 2 -> out env opAREINT2;
-
   | Kstop -> out env opSTOP
 
-  | Kareint _ -> assert false
-
 (* Emission of a current list and remaining lists of instructions. Include some peephole optimization. *)
 
 let rec emit env insns remaining = match insns with
@@ -406,8 +399,14 @@ let rec emit env insns remaining = match insns with
       emit env c remaining
   | Kpop n :: Kjump :: c ->
       out env opRETURN; out_int env n; emit env c remaining
-  | Ksequence(c1,c2)::c ->
-      emit env c1 (c2::c::remaining)
+  | Ksequence c1 :: c ->
+      emit env c1 (c :: remaining)
+  | Kprim (op1, (q1, _)) :: Kprim (op2, (q2, _)) :: c when inplace_prim_op op2 ->
+      out env (check_prim_op op1);
+      slot_for_getglobal env q1;
+      out env (check_prim_op_inplace op2);
+      slot_for_getglobal env q2;
+      emit env c remaining
   (* Default case *)
   | instr :: c ->
       emit_instr env instr; emit env c remaining