Suppression de Cmodify / Imodify.

Strength reduction sur les multiplications, divisions, modulo de
puissances de 2.


git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@147 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

asmcomp/arch_i386.ml

@@ -76,4 +76,3 @@ let print_specific_operation printreg op arg =
   | Ioffset_loc(n, addr) ->
       print_string "["; print_addressing printreg addr arg;
       print_string "] +:= "; print_int n
-

asmcomp/cmm.ml

@@ -56,7 +56,6 @@ type operation =
   | Calloc
   | Cstore
   | Cstorechunk of memory_chunk
-  | Cmodify
   | Caddi | Csubi | Cmuli | Cdivi | Cmodi
   | Cand | Cor | Cxor | Clsl | Clsr | Casr
   | Ccmpi of comparison

asmcomp/cmm.mli

@@ -42,7 +42,6 @@ type operation =
   | Calloc
   | Cstore
   | Cstorechunk of memory_chunk
-  | Cmodify
   | Caddi | Csubi | Cmuli | Cdivi | Cmodi
   | Cand | Cor | Cxor | Clsl | Clsr | Casr
   | Ccmpi of comparison

asmcomp/emit_alpha.mlp

@@ -393,23 +393,6 @@ let emit_instr i =
           end;
           `	addq	$13, 8, {emit_reg i.res.(0)}\n`
         end
-    | Lop(Imodify) ->
-        if !fastcode_flag then begin
-          `	ldq	$24, -8({emit_reg i.arg.(0)})\n`;
-          `	and	$24, 1024, $25\n`;
-          let lbl_call_modify = new_label() in
-          let lbl_continue = new_label() in
-          `	beq	$25, {emit_label lbl_call_modify}\n`;
-          modify_sites :=
-            { mod_lbl = lbl_call_modify;
-              mod_return_lbl = lbl_continue;
-              mod_instr = i } :: !modify_sites;
-          `{emit_label lbl_continue}:`
-        end else begin
-          `	mov	{emit_reg i.arg.(0)}, $25\n`;
-          liveregs i live_25;
-          `	jsr	caml_modify\n`   (* Pointer in $25 *)
-        end
     | Lop(Iintop(Icomp cmp)) ->
         let (comp, test) = name_for_int_comparison cmp in
         `	{emit_string comp}	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`;
@@ -422,11 +405,24 @@ let emit_instr i =
     | Lop(Iintop op) ->
         let instr = name_for_int_operation op in
         `	{emit_string instr}	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`
+    | Lop(Iintop_imm(Idiv, n)) when n = 1 lsl (Misc.log2 n) ->
+        let l = Misc.log2 n in
+        `	addq	{emit_reg i.arg.(0)}, {emit_int(n-1)}, $25\n`;
+        `	cmovge	{emit_reg i.arg.(0)}, {emit_reg i.arg.(0)}, $25\n`;
+        `	sra	$25, {emit_int l}, {emit_reg i.res.(0)}\n`
+    | Lop(Iintop_imm(Imod, n)) when n = 1 lsl (Misc.log2 n) ->
+        let l = Misc.log2 n in
+        `	and	{emit_reg i.arg.(0)}, {emit_int(n-1)}, $25\n`;
+        `	subq	$25, {emit_int n}, $24\n`;
+        `	cmovge	{emit_reg i.arg.(0)}, $25, $24\n`;
+        `	cmoveq	$25, $25, $24\n`;
+        `	move	$24, {emit_reg i.res.(0)}\n`
     | Lop(Iintop_imm(Icomp cmp, n)) ->
         let (comp, test) = name_for_int_comparison cmp in
         `	{emit_string comp}	{emit_reg i.arg.(0)}, {emit_int n}, {emit_reg i.res.(0)}\n`;
         if not test then
           `	xor	{emit_reg i.res.(0)}, 1, {emit_reg i.res.(0)}\n`
+
     | Lop(Iintop_imm(Icheckbound, n)) ->
         if !range_check_trap = 0 then range_check_trap := new_label();
         `	cmpule	{emit_reg i.arg.(0)}, {emit_int n}, $25\n`;

asmcomp/emit_i386.mlp

@@ -279,16 +279,6 @@ let emit_instr i =
           end;
           `{record_frame i.live}	leal	4(%eax), {emit_reg i.res.(0)}\n`
         end
-    | Lop(Imodify) ->
-        (* Argument is in eax *)
-        if !fastcode_flag then begin
-          `	testb	$4, -3(%eax)\n`;
-          let lbl_cont = new_label() in
-          `	jne	{emit_label lbl_cont}\n`;
-          `	call	_caml_fast_modify\n`;
-          `{emit_label lbl_cont}:\n`
-        end else
-          `	call	_caml_modify\n`
     | Lop(Iintop(Icomp cmp)) ->
         `	cmpl	{emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`;
         let b = name_for_cond_branch cmp in

asmcomp/emit_mips.mlp

@@ -319,8 +319,6 @@ let emit_instr i =
           end;
           `	addu	{emit_reg i.res.(0)}, $22, 4\n`
         end
-    | Lop(Imodify) ->
-        fatal_error "Emit_mips: Imodify"
     | Lop(Iintop(Icheckbound)) ->
         if !range_check_trap = 0 then range_check_trap := new_label();
         `	bleu	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_label !range_check_trap}\n`

asmcomp/emit_sparc.mlp

@@ -344,20 +344,6 @@ let emit_instr i =
           `	mov	{emit_int n}, %g4\n`;
           `	add	%g6, 4, {emit_reg i.res.(0)}\n`
         end
-    | Lop(Imodify) ->
-        if !fastcode_flag then begin
-          `	ld	[{emit_reg i.arg.(0)} - 4], %g4\n`;
-          `	andcc	%g4, 1024, %g0\n`;
-          let lbl_continue = new_label() in
-          `	bne	{emit_label lbl_continue}\n`;
-          `	nop\n`;
-          `	call	_caml_fast_modify\n`;
-          `	mov	{emit_reg i.arg.(0)}, %g1\n`;
-          `{emit_label lbl_continue}:\n`
-        end else begin
-          `	call	_caml_modify\n`;
-          `	mov	{emit_reg i.arg.(0)}, %g1\n`
-        end
     | Lop(Iintop Idiv) ->
         `	sra	{emit_reg i.arg.(0)}, 31, %g1\n`;
         `	wr	%g0, %g1, %y\n`;
@@ -389,21 +375,43 @@ let emit_instr i =
         let instr = name_for_int_operation op in
         `	{emit_string instr}	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`
     | Lop(Iintop_imm(Idiv, n)) ->
-        `	sra	{emit_reg i.arg.(0)}, 31, %g1\n`;
-        `	wr	%g0, %g1, %y\n`;
-        `	nop\n`;
-        `	nop\n`;
-        `	nop\n`;
-        `	sdiv	{emit_reg i.arg.(0)}, {emit_int n}, {emit_reg i.res.(0)}\n`
+        let l = Misc.log2 n in
+        if n = 1 lsl l then begin
+          let lbl = new_label() in
+          `	tst	{emit_reg i.arg.(0)}\n`;
+          `	bge	{emit_label lbl}\n`;
+          `	mov	{emit_reg i.arg.(0)}, %g1\n` (* in delay slot *)
+          `	add	%g1, {emit_int (n-1)}, %g1\n`
+          `{emit_label lbl}:	sra	%g1, {emit_int n}, {emit_reg i.res.(0)}\n`
+        end else begin
+          `	sra	{emit_reg i.arg.(0)}, 31, %g1\n`;
+          `	wr	%g0, %g1, %y\n`;
+          `	nop\n`;
+          `	nop\n`;
+          `	nop\n`;
+          `	sdiv	{emit_reg i.arg.(0)}, {emit_int n}, {emit_reg i.res.(0)}\n`
+        end
     | Lop(Iintop_imm(Imod, n)) ->
-        `	sra	{emit_reg i.arg.(0)}, 31, %g1\n`;
-        `	wr	%g0, %g1, %y\n`;
-        `	nop\n`;
-        `	nop\n`;
-        `	nop\n`;
-        `	sdiv	{emit_reg i.arg.(0)}, {emit_int n}, %g1\n`;
-        `	smul	%g1, {emit_int n}, %g1\n`;
-        `	sub	{emit_reg i.arg.(0)}, %g1, {emit_reg i.res.(0)}\n`
+        let l = Misc.log2 n in
+        if n = 1 lsl l then begin
+          let lbl = new_label() in
+          `	tst	{emit_reg i.arg.(0)}\n`;
+          `	bge	{emit_label lbl}\n`;
+          `	andcc	{emit_reg i.arg.(0)}, {emit_int (n-1)}, {emit_reg i.res.(0)}\n`; (* in delay slot *)
+          `	be	{emit_label lbl}\n`;
+          `	nop\n`;
+          `	sub	{emit_reg i.res.(0)}, {emit_int n}, {emit_reg i.res.(0)}\n`;
+          `{emit_label lbl}:\n`
+        end else begin
+          `	sra	{emit_reg i.arg.(0)}, 31, %g1\n`;
+          `	wr	%g0, %g1, %y\n`;
+          `	nop\n`;
+          `	nop\n`;
+          `	nop\n`;
+          `	sdiv	{emit_reg i.arg.(0)}, {emit_int n}, %g1\n`;
+          `	smul	%g1, {emit_int n}, %g1\n`;
+          `	sub	{emit_reg i.arg.(0)}, %g1, {emit_reg i.res.(0)}\n`
+        end
     | Lop(Iintop_imm(Icomp cmp, n)) ->
         let comp = name_for_int_comparison cmp in
         `	cmp	{emit_reg i.arg.(0)}, {emit_int n}\n`;

asmcomp/mach.ml

@@ -35,7 +35,6 @@ type operation =
   | Iload of Cmm.memory_chunk * Arch.addressing_mode
   | Istore of Cmm.memory_chunk * Arch.addressing_mode
   | Ialloc of int
-  | Imodify
   | Iintop of integer_operation
   | Iintop_imm of integer_operation * int
   | Iaddf | Isubf | Imulf | Idivf

asmcomp/mach.mli

@@ -35,7 +35,6 @@ type operation =
   | Iload of Cmm.memory_chunk * Arch.addressing_mode
   | Istore of Cmm.memory_chunk * Arch.addressing_mode
   | Ialloc of int
-  | Imodify
   | Iintop of integer_operation
   | Iintop_imm of integer_operation * int
   | Iaddf | Isubf | Imulf | Idivf

asmcomp/printcmm.ml

@@ -43,7 +43,6 @@ let operation = function
   | Calloc -> print_string "alloc"
   | Cstore -> print_string "store"
   | Cstorechunk c -> print_string "store "; chunk c
-  | Cmodify -> print_string "modify"
   | Caddi -> print_string "+"
   | Csubi -> print_string "-"
   | Cmuli -> print_string "*"

asmcomp/printmach.ml

@@ -117,7 +117,6 @@ let operation op arg res =
       print_string "] := ";
       reg arg.(0)
   | Ialloc n -> print_string "alloc "; print_int n
-  | Imodify -> print_string "modify "; reg arg.(0)
   | Iintop(op) -> reg arg.(0); intop op; reg arg.(1)
   | Iintop_imm(op, n) -> reg arg.(0); intop op; print_int n
   | Iaddf -> reg arg.(0); print_string " +f "; reg arg.(1)

asmcomp/proc_i386.ml

@@ -195,16 +195,13 @@ let pseudoregs_for_operation op arg res =
   | Iintop(Imod) ->
       ([|phys_reg 0; arg.(1)|], [|phys_reg 3|])
     (* For storing a byte, the argument must be in eax...edx.
-       For storing a word, any reg is ok.
+       For storing a halfword, any reg is ok.
        Keep it simple, just force it to be in edx in both cases. *)
   | Istore(Word, addr) -> raise Use_default
   | Istore(chunk, addr) ->
       let newarg = Array.copy arg in
       newarg.(0) <- phys_reg 3;
       (newarg, res)
-    (* For modify, the argument must be in eax *)
-  | Imodify ->
-      ([|phys_reg 0|], [||])
     (* Other instructions are more or less regular *)
   | _ -> raise Use_default
 
@@ -268,7 +265,6 @@ let destroyed_at_oper = function
   | Iop(Iextcall(_, false)) -> destroyed_at_c_call
   | Iop(Iintop(Idiv | Imod)) -> [| phys_reg 0; phys_reg 3 |] (* eax, edx *)
   | Iop(Ialloc _) -> [| phys_reg 0|] (* eax *)
-  | Iop(Imodify) -> [| phys_reg 0 |] (* eax *)
   | Iop(Iintop(Icomp _) | Iintop_imm(Icomp _, _)) -> [| phys_reg 0 |] (* eax *)
   | Iop(Iintoffloat) -> [| phys_reg 0 |] (* eax *)
   | Iifthenelse(Ifloattest _, _, _) -> [| phys_reg 0 |] (* eax *)
@@ -283,7 +279,7 @@ let safe_register_pressure op = 4
 let max_register_pressure = function
     Iextcall(_, _) -> [| 4; 4 |]
   | Iintop(Idiv | Imod) -> [| 5; 4 |]
-  | Ialloc _ | Imodify | Iintop(Icomp _) | Iintop_imm(Icomp _, _) |
+  | Ialloc _ | Iintop(Icomp _) | Iintop_imm(Icomp _, _) |
     Iintoffloat -> [| 6; 4 |]
   | _ -> [|7; 4|]
 

asmcomp/proc_sparc.ml

@@ -45,15 +45,7 @@ let select_addressing exp =
 
 (* Instruction selection *)
 
-let select_oper op args =
-  match (op, args) with
-    (Cmuli, [arg1; Cconst_int n]) ->
-      let shift = Misc.log2 n in
-      if n = 1 lsl shift
-      then (Iintop_imm(Ilsl, shift), [arg1])
-      else raise Use_default
-  | _ ->
-      raise Use_default
+let select_oper op args = raise Use_default
 
 let select_store addr exp = raise Use_default
 

asmcomp/selection.ml

@@ -16,7 +16,6 @@ let oper_result_type = function
   | Calloc -> typ_addr
   | Cstore -> typ_void
   | Cstorechunk c -> typ_void
-  | Cmodify -> typ_void
   | Caddi | Csubi | Cmuli | Cdivi | Cmodi
   | Cand | Cor | Cxor | Clsl | Clsr | Casr
   | Ccmpi _ | Ccmpa _ | Ccmpf _ -> typ_int
@@ -58,7 +57,7 @@ let rec size_expr env = function
 let cheap_operation = function
     (* The following may have side effects *)
     Capply _ | Cextcall(_, _, _) | Calloc | Cstore | Cstorechunk _ | 
-    Cmodify | Craise -> false
+    Craise -> false
     (* The following are expensive to compute, better start them early *)
   | Caddf | Csubf | Cmulf | Cdivf | Cfloatofint | Cintoffloat -> false
     (* The remaining operations are cheap *)
@@ -84,9 +83,13 @@ let rec sel_operation op args =
       let (addr, eloc) = Proc.select_addressing arg1 in
       (Istore(chunk, addr), eloc :: rem)
   | (Calloc, _) -> (Ialloc 0, args)
-  | (Cmodify, _) -> (Imodify, args)
   | (Caddi, _) -> sel_arith_comm Iadd args
   | (Csubi, _) -> sel_arith Isub args
+  | (Cmuli, [arg1; Cconst_int n]) ->
+      let l = Misc.log2 n in
+      if n = 1 lsl l
+      then (Iintop_imm(Ilsl, l), [arg1])
+      else sel_arith_comm Imul args
   | (Cmuli, _) -> sel_arith_comm Imul args
   | (Cdivi, _) -> sel_arith Idiv args
   | (Cmodi, _) -> sel_arith_comm Imod args
@@ -401,7 +404,6 @@ let rec emit_expr env exp seq =
             (Arch.offset_addressing Arch.identity_addressing (-Arch.size_int));
           rd
       | op ->
-          if op = Imodify then Proc.contains_calls := true;
           let r1 = emit_tuple env new_args seq in
           let rd = Reg.newv ty in
           begin try