1 files changed, 65 insertions, 9 deletions

diff --git a/scheduling/RTLpathScheduleraux.ml b/scheduling/RTLpathScheduleraux.ml
index e04e7c23..02e0c769 100644
--- a/scheduling/RTLpathScheduleraux.ml
+++ b/scheduling/RTLpathScheduleraux.ml
@@ -72,7 +72,60 @@ let get_superblocks code entry pm typing =
     lsb
 end
 
+(** the useful one. Returns a hashtable with bindings of form 
+ ** [(r,(t, n)], where [r] is a pseudo-register (Registers.reg),
+ ** [t] is its class (according to [typing]), and [n] the number of
+ ** times it's referenced as an argument in instructions of [seqa] ;
+ ** and an arrray containg the argument regset of each instruction *)
+let reference_counting (seqa : (instruction * Regset.t) array)
+      (out_regs : Registers.Regset.t) (typing : RTLtyping.regenv) :
+      (Registers.reg, int * int) Hashtbl.t * Registers.reg list array =
+  let retl = Hashtbl.create 42 in
+  let retr = Array.make (Array.length seqa) [] in
+  List.iter (fun reg ->
+      Hashtbl.add retl
+        reg (Machregsaux.class_of_type (typing reg), 1)
+    ) (Registers.Regset.elements out_regs);
+  let add_reg reg = 
+    match Hashtbl.find_opt retl reg with
+    | Some (t, n) -> Hashtbl.add retl reg (t, n+1)
+    | None -> Hashtbl.add retl reg (Machregsaux.class_of_type
+                                    (typing reg), 1)
+  in
+  Array.iteri (fun i  (ins, _) ->
+      match ins with
+      | Iop(_,args,_,_) | Iload(_,_,_,args,_,_)
+      | Icond(_,args,_,_,_) ->
+         List.iter (add_reg) args;
+         retr.(i) <- args
+      | Istore(_,_,args,src,_) ->
+         List.iter (add_reg) args;
+         add_reg src;
+         retr.(i) <- src::args
+      | Icall(_,fn,args,_,_) | Itailcall(_,fn,args) ->
+         List.iter (add_reg) args;
+         retr.(i) <- (match fn with
+                     | Datatypes.Coq_inl reg ->
+                        add_reg reg;
+                        reg::args
+                     | _ -> args)
+      | Ibuiltin(_,args,_,_) ->
+         let rec bar = function
+           | AST.BA r -> add_reg r;
+                        retr.(i) <- r::retr.(i)
+           | AST.BA_splitlong  (hi, lo) | AST.BA_addptr (hi, lo) ->
+              bar hi; bar lo
+           | _ -> ()
+         in
+         List.iter (bar) args
+      | Ijumptable (reg,_) | Ireturn (Some reg) ->
+         add_reg reg;
+         retr.(i) <- [reg]
+      | _ -> ()
+    ) seqa;
+  retl, retr
 
+  
 let get_live_regs_entry (sb : superblock) code =
   (if !Clflags.option_debug_compcert > 6
    then debug_flag := true);
@@ -164,17 +217,20 @@ let schedule_superblock sb code =
          | None -> 1 in
     debug "hello\n";
     let live_regs_entry = get_live_regs_entry sb code in
+    let seqa = 
+      Array.map (fun i ->
+          (match PTree.get i code with
+           | Some ii -> ii
+           | None -> failwith "RTLpathScheduleraux.schedule_superblock"),
+          (match PTree.get i sb.liveins with
+           | Some s -> s
+           | None -> Regset.empty))
+        (Array.sub sb.instructions 0 (nr_instr-trailer_length)) in
     match PrepassSchedulingOracle.schedule_sequence
-            (Array.map (fun i ->
-                 (match PTree.get i code with
-                 | Some ii -> ii
-                 | None -> failwith "RTLpathScheduleraux.schedule_superblock"),
-                 (match PTree.get i sb.liveins with
-                 | Some s -> s
-                 | None -> Regset.empty))
-               (Array.sub sb.instructions 0 (nr_instr-trailer_length)))
+            seqa
             live_regs_entry
-            sb.typing with
+            sb.typing
+            (reference_counting seqa sb.s_output_regs sb.typing) with
     | None -> sb.instructions
     | Some order ->
        let ins' =