cmmgen: pour le let rec de valeur, passer par modify.

selection: simplification du cas "Cstore", plus de store multiple.


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

asmcomp/cmmgen.ml

@@ -312,13 +312,27 @@ let dummy_block size =
   Cop(Calloc, alloc_block_header 0 size :: init_val 0)
 
 let rec store_contents ptr = function
-    Cop(Calloc, fields) ->
-      Cop(Cstore, field_address ptr (-1) :: fields)
+    Cop(Calloc, header :: fields) ->
+      Csequence(Cop(Cstore, [field_address ptr (-1); header]),
+                store_fields ptr 0 fields)
   | Clet(id, exp, body) ->
       Clet(id, exp, store_contents ptr body)
   | _ ->
       fatal_error "Cmmgen.store_contents"
 
+and store_fields ptr pos = function
+    [] -> Ctuple []
+  | c :: rem ->
+      let store =
+        match c with
+          Cconst_int _ | Cconst_symbol _ | Cconst_pointer _ ->
+            Cop(Cstore, [field_address ptr pos; c])
+        | _ ->
+            Cop(Cextcall("modify", typ_void, false),
+                [field_address ptr pos; c]) in
+      Csequence(store, store_fields ptr (pos + 1) rem)
+            
+
 (* Record application and currying functions *)
 
 let apply_function n =
@@ -838,52 +852,6 @@ let rec transl_all_functions already_translated cont =
   with Queue.Empty ->
     cont
 
-(* Translate a toplevel structure definition *)
-
-let rec transl_structure glob = function
-    Uprim(Pmakeblock(tag, mut), args) ->
-      (* Scan the args, storing those that are not identifiers and
-         returning a hashtable id -> position in block
-         for those that are idents. *)
-      let map = Hashtbl.create 17 in
-      let rec make_stores pos = function
-        [] -> Ctuple []
-      | Uvar v :: rem ->
-          Hashtbl.add map v pos;
-          make_stores (pos+1) rem
-      | ulam :: rem ->
-          Csequence(Cop(Cstore,
-                        [field_address (Cconst_symbol glob) pos; transl ulam]),
-                    make_stores (pos+1) rem) in
-      let c = make_stores 0 args in
-      (c, map, List.length args)
-  | Usequence(e1, e2) ->
-      let (c2, map, size) = transl_structure glob e2 in
-      (Csequence(remove_unit(transl e1), c2), map, size)
-  | Ulet(id, arg, body) ->
-      let (cbody, map, size) = transl_structure glob body in
-      (Clet(id, transl arg, add_store glob id map cbody), map, size)
-  | Uletrec(bindings, body) ->
-      let (cbody, map, size) = transl_structure glob body in
-      (transl_letrec bindings (add_stores glob bindings map cbody), map, size)
-  | Uprim(Psetglobal id, [arg]) ->
-      transl_structure glob arg
-  | _ ->
-      fatal_error "Cmmgen.transl_structure"
-
-and add_store glob id map code =
-  let rec store = function
-    [] -> code
-  | pos :: rem ->
-      Csequence(Cop(Cstore, [field_address (Cconst_symbol glob) pos; Cvar id]),
-                store rem) in
-  store (Hashtbl.find_all map id)
-
-and add_stores glob bindings map code =
-  match bindings with
-    [] -> code
-  | (id, def) :: rem -> add_stores glob rem map (add_store glob id map code) 
-
 (* Emit structured constants *)
 
 let rec emit_constant symb cst cont =

asmcomp/selection.ml

@@ -87,9 +87,15 @@ let rec sel_operation op args =
   | (Cloadchunk chunk, [arg]) ->
       let (addr, eloc) = Proc.select_addressing arg in
       (Iload(chunk, addr), [eloc])
-  | (Cstore, arg1 :: rem) ->
+  | (Cstore, [arg1; arg2]) ->
       let (addr, eloc) = Proc.select_addressing arg1 in
-      (Istore(Word, addr), eloc :: rem)
+      begin try
+        let (op, newarg2) = Proc.select_store addr arg2 in
+        (op, [newarg2; eloc])
+      with Proc.Use_default ->
+        (Istore(Word, addr), [arg2; eloc])
+        (* Inversion addr/datum in Istore *)
+      end
   | (Cstorechunk chunk, [arg1; arg2]) ->
       let (addr, eloc) = Proc.select_addressing arg1 in
       (Istore(chunk, addr), [arg2; eloc])
@@ -423,14 +429,6 @@ let rec emit_expr env exp seq =
           let r1 = emit_tuple env new_args seq in
           let rd = Reg.createv ty in
           insert_op (Iload(Word, addr)) r1 rd seq
-      | Istore(Word, addr) ->
-          begin match new_args with
-            [] -> fatal_error "Selection.Istore"
-          | arg_addr :: args_data ->
-              let ra = emit_expr env arg_addr seq in
-              emit_stores env args_data seq ra addr;
-              [||]
-          end
       | Ialloc _ ->
           Proc.contains_calls := true;
           let rd = Reg.createv typ_addr in