Commits

Anonymous committed 1996b6e

Iloop est maintenant une boucle infinie, on en sort par catch...exit.
Ca supprime Ilooptest, Ialwaystrue, Ialwaysfalse.

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

  • Participants
  • Parent commits dbcdb15

Comments (0)

Files changed (14)

-ARCH=sparc
+ARCH=alpha
 
 include ../Makefile.config
 

asmcomp/emit_alpha.mlp

         `	stt	$f30, 0($sp)\n`;
         `	ldq	{emit_reg i.res.(0)}, 0($sp)\n`;
         `	lda	$sp, 8($sp)\n`
-    | Lop(Ilooptest tst) ->
-        fatal_error "Emit_alpha: looptest"
     | Lop(Ispecific sop) ->
         let instr = name_for_specific_operation sop in
         `	{emit_string instr}	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`
         `	br	{emit_label lbl}\n`
     | Lcondbranch(tst, lbl) ->
         begin match tst with
-          Ialwaystrue ->
-            `	br	{emit_label lbl}\n`
-        | Ialwaysfalse -> ()
-        | Itruetest ->
+          Itruetest ->
             `	bne	{emit_reg i.arg.(0)}, {emit_label lbl}\n`
         | Ifalsetest ->
             `	beq	{emit_reg i.arg.(0)}, {emit_label lbl}\n`

asmcomp/emit_i386.mlp

         `	neg	{emit_reg i.res.(0)}\n`
     | Lop(Ispecific(Ilea addr)) ->
         `	lea	{emit_addressing addr i.arg 0}, {emit_reg i.res.(0)}\n`
-    | Lop(Ilooptest tst) ->
-        fatal_error "Emit_i386: looptest"
     | Lreturn ->
         let n = frame_size() - 4 in
         if n > 0 then
         `	jmp	{emit_label lbl}\n`
     | Lcondbranch(tst, lbl) ->
         begin match tst with
-          Ialwaystrue ->
-            `	jmp	{emit_label lbl}\n`
-        | Ialwaysfalse -> ()
-        | Itruetest ->
+          Itruetest ->
             `	cmpl	$0, {emit_reg i.arg.(0)}\n`;
             `	jne	{emit_label lbl}\n`
         | Ifalsetest ->

asmcomp/emit_sparc.mlp

         `	st	%f30, [%sp + 96]\n`;
         `	ld	[%sp + 96], {emit_reg i.res.(0)}\n`;
         `	add	%sp, 4, %sp\n`
-    | Lop(Ilooptest tst) ->
-        fatal_error "Emit: looptest"
     | Lop(Ispecific sop) ->
         fatal_error "Emit: specific"
     | Lreturn ->
         `	nop\n`
     | Lcondbranch(tst, lbl) ->
         begin match tst with
-          Ialwaystrue ->
-            `	b	{emit_label lbl}\n`;
-            `	nop\n`
-        | Ialwaysfalse -> ()
-        | Itruetest ->
+          Itruetest ->
             `	tst	{emit_reg i.arg.(0)}\n`;
             `	bne	{emit_label lbl}\n`;
             `	nop\n`

asmcomp/linearize.ml

   | Iunsigned cmp -> Iunsigned(Cmm.negate_comparison cmp)
 
 let invert_test = function
-    Ialwaystrue -> Ialwaysfalse
-  | Ialwaysfalse -> Ialwaystrue
-  | Itruetest -> Ifalsetest
+    Itruetest -> Ifalsetest
   | Ifalsetest -> Itruetest
   | Iinttest(cmp) -> Iinttest(invert_integer_test cmp)
   | Iinttest_imm(cmp, n) -> Iinttest_imm(invert_integer_test cmp, n)
     Llabel lbl1 when lbl1 = lbl -> n1
   | _ -> cons_instr (Lbranch lbl) n1
 
-(* Current label for exit handler and for loop entry *)
+(* Current label for exit handler *)
 
 let exit_label = ref 99
-let loop_label = ref 99
 
 (* Linearize an instruction [i]: add it in front of the continuation [n] *)
 
     Iend -> n
   | Iop(Itailcall_ind | Itailcall_imm _ as op) ->
       copy_instr (Lop op) i (discard_dead_code n)
-  | Iop(Ilooptest Ialwaystrue) ->
-      add_branch !loop_label n
-  | Iop(Ilooptest Ialwaysfalse) ->
-      n
-  | Iop(Ilooptest test) ->
-      copy_instr (Lcondbranch(test, !loop_label)) i n
   | Iop op ->
       copy_instr (Lop op) i (linear i.Mach.next n)
   | Ireturn ->
       copy_instr Lreturn i (discard_dead_code n)
-  | Iifthenelse(Ialwaystrue, ifso, ifnot) ->
-      linear ifso (linear i.Mach.next n)
-  | Iifthenelse(Ialwaysfalse, ifso, ifnot) ->
-      linear ifnot (linear i.Mach.next n)
   | Iifthenelse(test, ifso, ifnot) ->
       let n1 = linear i.Mach.next n in
       begin match (ifso.Mach.desc, ifnot.Mach.desc) with
-        (Iend, _) ->
+        Iexit, _ ->
+          copy_instr (Lcondbranch(test, !exit_label)) i
+            (linear ifnot n1)
+      | _,  Iexit ->
+          copy_instr (Lcondbranch(invert_test test, !exit_label)) i
+            (linear ifso n1)
+      | Iend, _ ->
           let (lbl_end, n2) = get_label n1 in
           copy_instr (Lcondbranch(test, lbl_end)) i
             (linear ifnot n2)
-      | (_, Iend) ->
+      | _,  Iend ->
           let (lbl_end, n2) = get_label n1 in
           copy_instr (Lcondbranch(invert_test test, lbl_end)) i
             (linear ifso n2)
-      | (Iexit, _) ->
-          copy_instr (Lcondbranch(test, !exit_label)) i
-            (linear ifnot n1)
-      | (_, Iexit) ->
-          copy_instr (Lcondbranch(invert_test test, !exit_label)) i
-            (linear ifso n1)
-      | _ ->
+      | _, _ ->
         (* Should attempt branch prediction here *)
           let (lbl_end, n2) = get_label n1 in
           let (lbl_else, nelse) = get_label (linear ifnot n2) in
   | Iloop body ->
       let lbl_head = new_label() in
       let n1 = linear i.Mach.next n in
-      let saved_loop_label = !loop_label in
-      loop_label := lbl_head;
-      let n2 = linear body n1 in
-      loop_label := saved_loop_label;
+      let n2 = linear body (cons_instr (Lbranch lbl_head) n1) in
       cons_instr (Llabel lbl_head) n2
   | Icatch(body, handler) ->
       let (lbl_end, n1) = get_label(linear i.Mach.next n) in

asmcomp/liveness.ml

 open Mach
 
 let live_at_exit = ref Reg.Set.empty
+let live_at_break = ref Reg.Set.empty
 let live_at_raise = ref Reg.Set.empty
 
 let rec live i finally =
       i.live <- !at_fork;
       Reg.add_set_array !at_fork i.arg
   | Iloop(body) ->
-      let at_exit = live i.next finally in
-      let at_entrance = ref at_exit in
+      let at_top = ref Reg.Set.empty in
       (* Yes, there are better algorithms, but we'll just iterate till
          reaching a fixpoint. *)
       begin try
         while true do
-          let new_at_entrance =
-            Reg.Set.union !at_entrance (live body !at_entrance) in
-          if Reg.Set.equal !at_entrance new_at_entrance then raise Exit;
-          at_entrance := new_at_entrance
+          let new_at_top = Reg.Set.union !at_top (live body !at_top) in
+          if Reg.Set.equal !at_top new_at_top then raise Exit;
+          at_top := new_at_top
         done
       with Exit -> ()
       end;
-      i.live <- !at_entrance;
-      !at_entrance
+      i.live <- !at_top;
+      !at_top
   | Icatch(body, handler) ->
       let at_join = live i.next finally in
       let before_handler = live handler at_join in
   | Icomp of integer_comparison
 
 type test =
-    Ialwaystrue
-  | Ialwaysfalse
-  | Itruetest
+    Itruetest
   | Ifalsetest
   | Iinttest of integer_comparison
   | Iinttest_imm of integer_comparison * int
   | Iintop_imm of integer_operation * int
   | Iaddf | Isubf | Imulf | Idivf
   | Ifloatofint | Iintoffloat
-  | Ilooptest of test
   | Ispecific of Arch.specific_operation
 
 type instruction =
   | Icomp of integer_comparison
 
 type test =
-    Ialwaystrue
-  | Ialwaysfalse
-  | Itruetest
+    Itruetest
   | Ifalsetest
   | Iinttest of integer_comparison
   | Iinttest_imm of integer_comparison * int
   | Iintop_imm of integer_operation * int
   | Iaddf | Isubf | Imulf | Idivf
   | Ifloatofint | Iintoffloat
-  | Ilooptest of test
   | Ispecific of Arch.specific_operation
 
 type instruction =

asmcomp/printmach.ml

     
 let test tst arg =
   match tst with
-    Ialwaystrue -> print_string "true"
-  | Ialwaysfalse -> print_string "false"
-  | Itruetest -> reg arg.(0)
+    Itruetest -> reg arg.(0)
   | Ifalsetest -> print_string "not "; reg arg.(0)
   | Iinttest cmp -> reg arg.(0); intcomp cmp; reg arg.(1)
   | Iinttest_imm(cmp, n) -> reg arg.(0); intcomp cmp; print_int n
   | Idivf -> reg arg.(0); print_string " /f "; reg arg.(1)
   | Ifloatofint -> print_string "floatofint "; reg arg.(0)
   | Iintoffloat -> print_string "intoffloat "; reg arg.(0)
-  | Ilooptest tst -> print_string "while "; test tst arg
   | Ispecific op -> Arch.print_specific_operation reg op arg
 
 let rec instr i =

asmcomp/proc_i386.ml

   | Iop(Imodify) -> [| phys_reg 0 |] (* eax *)
   | Iop(Iintop(Icomp _) | Iintop_imm(Icomp _, _)) -> [| phys_reg 0 |] (* eax *)
   | Iop(Iintoffloat) -> [| phys_reg 0 |] (* eax *)
-  | Iop(Ilooptest(Ifloattest _)) -> [| phys_reg 0 |] (* eax *)
   | Iifthenelse(Ifloattest _, _, _) -> [| phys_reg 0 |] (* eax *)
   | _ -> [||]
 
 
 let reload_operation makereg op arg res =
   match op with
-    Iintop(Iadd|Isub|Imul|Iand|Ior|Ixor|Icomp _) | Ilooptest(Iinttest _) ->
+    Iintop(Iadd|Isub|Imul|Iand|Ior|Ixor|Icomp _) ->
       (* One of the two arguments can reside in the stack *)
       if stackp arg.(0) & stackp arg.(1)
       then ([|arg.(0); makereg arg.(1)|], res)
       else (arg, res)
   | Iintop(Ilsl|Ilsr|Iasr) | Iintop_imm(_, _) | Ispecific Ineg |
-    Iaddf | Isubf | Imulf | Idivf | Ifloatofint | Iintoffloat |
-    Ilooptest _ ->
+    Iaddf | Isubf | Imulf | Idivf | Ifloatofint | Iintoffloat ->
       (* The argument(s) can be either in register or on stack *)
       (arg, res)
   | _ -> (* Other operations: all args and results in registers *)

asmcomp/selection.ml

   | Ssequence of expression * expression
   | Sifthenelse of test * expression * expression * expression
   | Sswitch of expression * int array * expression array
-  | Sloop of expression * test * expression
+  | Sloop of expression
   | Scatch of expression * expression
   | Sexit
   | Strywith of expression * Ident.t * expression
       (Iinttest(Iunsigned cmp), Ctuple args)
   | Cop(Ccmpf cmp, args) ->
       (Ifloattest cmp, Ctuple args)
-  | Cconst(Const_int n) ->
-      ((if n <> 0 then Ialwaystrue else Ialwaysfalse), Ctuple [])
   | arg ->
       (Itruetest, arg)
 
         let (_, n) = scases.(i) in need := max !need n
       done;
       (Sswitch(ssel, index, Array.map (fun (s, n) -> s) scases), !need)
+  | Cwhile(Cconst(Const_int 1), ebody) ->
+      let (sbody, nbody) = sel_expr ebody in
+      (Sloop sbody, nbody)
   | Cwhile(econd, ebody) ->
       let (cond, earg) = sel_condition econd in
       let (sarg, narg) = sel_expr earg in
       let (sbody, nbody) = sel_expr ebody in
-      (Sifthenelse(cond, sarg, Sloop(sbody, cond, sarg), Stuple([||], [])),
+      (Scatch(Sloop(Sifthenelse(cond, sarg, sbody, Sexit)), Stuple([||], [])),
        max narg nbody)
   | Ccatch(e1, e2) ->
       let (s1, n1) = sel_expr e1 in
       let (s2, n2) = sel_expr e2 in
-      (Ssequence(s1, s2), max n1 n2)
+      (Scatch(s1, s2), max n1 n2)
   | Cexit ->
       (Sexit, 0)
   | Ctrywith(e1, v, e2) ->

asmcomp/selection.mli

   | Ssequence of expression * expression
   | Sifthenelse of Mach.test * expression * expression * expression
   | Sswitch of expression * int array * expression array
-  | Sloop of expression * Mach.test * expression
+  | Sloop of expression
   | Scatch of expression * expression
   | Sexit
   | Strywith of expression * Ident.t * expression

asmcomp/sequence.ml

                       Array.map (fun (r, s) -> extract_sequence s) rscases))
              rsel [||] seq;
       r
-  | Sloop(ebody, tst, econd) ->
-      let (rarg, sbody) = emit_sequence env (Ssequence(ebody, econd)) in
-      insert (Iop(Ilooptest tst)) rarg [||] sbody;
+  | Sloop(ebody) ->
+      let (rarg, sbody) = emit_sequence env ebody in
       insert (Iloop(extract_sequence sbody)) [||] [||] seq;
       [||]
   | Scatch(e1, e2) ->
     regset i
 
 let reload_at_exit = ref Reg.Set.empty
+let reload_at_break = ref Reg.Set.empty
 
 let rec reload i before =
   match i.desc with
                                i.arg i.res new_next),
        finally)
   | Iloop(body) ->
-      let (initial_new_body, initial_at_exit) = reload body before in
-      let at_exit = ref initial_at_exit in
-      let final_body = ref initial_new_body in
+      let at_head = ref before in
+      let final_body = ref body in
       begin try
         while true do
-          let (new_body, new_at_exit) = reload body !at_exit in
-          let merged_at_exit = Reg.Set.union !at_exit new_at_exit in
-          if Reg.Set.equal merged_at_exit !at_exit then begin
+          let (new_body, new_at_head) = reload body !at_head in
+          let merged_at_head = Reg.Set.union !at_head new_at_head in
+          if Reg.Set.equal merged_at_head !at_head then begin
             final_body := new_body;
             raise Exit
           end;
-          at_exit := merged_at_exit
+          at_head := merged_at_head
         done
       with Exit -> ()
       end;
-      let (new_next, finally) = reload i.next !at_exit in
+      let (new_next, finally) = reload i.next Reg.Set.empty in
       (instr_cons (Iloop(!final_body)) i.arg i.res new_next,
        finally)
   | Icatch(body, handler) ->
       (instr_cons (Iswitch(index, new_cases)) i.arg i.res new_next,
        !before)
   | Iloop(body) ->
-      let (new_next, at_exit) = spill i.next finally in
-      let at_entrance = ref at_exit in
+      let (new_next, _) = spill i.next finally in
+      let at_head = ref Reg.Set.empty in
       let final_body = ref body in
       begin try
         while true do
-          let (new_body, before_body) = spill body !at_entrance in
-          let new_at_entrance = Reg.Set.union !at_entrance before_body in
-          if Reg.Set.equal new_at_entrance !at_entrance then begin
+          let (new_body, before_body) = spill body !at_head in
+          let new_at_head = Reg.Set.union !at_head before_body in
+          if Reg.Set.equal new_at_head !at_head then begin
             final_body := new_body; raise Exit
           end;
-          at_entrance := new_at_entrance
+          at_head := new_at_head
         done
       with Exit -> ()
       end;
       (instr_cons (Iloop(!final_body)) i.arg i.res new_next,
-       !at_entrance)
+       !at_head)
   | Icatch(body, handler) ->
       let (new_next, at_join) = spill i.next finally in
       let (new_handler, at_exit) = spill handler at_join in