---

yaml
---
r: 658
b: refs/heads/master
c: 79dc07d
h: refs/heads/master
v: v3

Author: graydon

[refs]

@@ -1,2 +1,2 @@
 ---
-refs/heads/master: a9e2327a18e782df524c14dc42910d61a4785324
+refs/heads/master: 79dc07d6487612ebf9ac62e43a5729ea774488b9

trunk/src/boot/be/abi.ml

@@ -118,7 +118,7 @@ type abi =
     abi_str_of_hardreg: (int -> string);
 
     abi_emit_target_specific: (Il.emitter -> Il.quad -> unit);
-    abi_constrain_vregs: (Il.quad -> Bits.t array -> unit);
+    abi_constrain_vregs: (Il.quad -> (Il.vreg,Bits.t) Hashtbl.t -> unit);
 
     abi_emit_fn_prologue: (Il.emitter
                            -> Common.size        (* framesz *)

trunk/src/boot/be/ra.ml

@@ -324,11 +324,11 @@ let dump_quads cx =
 
 let calculate_vreg_constraints
     (cx:ctxt)
-    (constraints:Bits.t array)
+    (constraints:(Il.vreg,Bits.t) Hashtbl.t)
     (q:quad)
     : unit =
   let abi = cx.ctxt_abi in
-    Array.iter (fun c -> Bits.clear c; Bits.invert c) constraints;
+    Hashtbl.clear constraints;
     abi.Abi.abi_constrain_vregs q constraints;
     iflog cx
       begin
@@ -341,9 +341,12 @@ let calculate_vreg_constraints
                 match r with
                     Il.Hreg _ -> ()
                   | Il.Vreg v ->
-                      let hregs = Bits.to_list constraints.(v) in
-                        log cx "<v%d> constrained to hregs: [%s]"
-                          v (list_to_str hregs hr_str)
+                      match htab_search constraints v with
+                          None -> log cx "<v%d> unconstrained" v
+                        | Some c ->
+                            let hregs = Bits.to_list c in
+                              log cx "<v%d> constrained to hregs: [%s]"
+                                v (list_to_str hregs hr_str)
               end;
               r
             in
@@ -376,10 +379,9 @@ let reg_alloc
     let (live_in_vregs, live_out_vregs) =
       calculate_live_bitvectors cx
     in
-    let n_vregs = cx.ctxt_n_vregs in
-    let n_hregs = abi.Abi.abi_n_hardregs in
-    let (vreg_constraints:Bits.t array) = (* vreg idx -> hreg bits.t *)
-      Array.init n_vregs (fun _ -> Bits.create n_hregs true)
+      (* vreg idx -> hreg bits.t *)
+    let (vreg_constraints:(Il.vreg,Bits.t) Hashtbl.t) =
+      Hashtbl.create 0
     in
     let inactive_hregs = ref [] in (* [hreg] *)
     let active_hregs = ref [] in (* [hreg] *)
@@ -497,6 +499,13 @@ let reg_alloc
       else ()
     in
 
+    let get_vreg_constraints v =
+      match htab_search vreg_constraints v with
+          None -> all_hregs
+        | Some c -> c
+    in
+
+
     let use_vreg def i vreg =
       if Hashtbl.mem vreg_to_hreg vreg
       then
@@ -508,18 +517,19 @@ let reg_alloc
         end
       else
         let hreg =
-          let constrs = vreg_constraints.(vreg) in
-          match select_constrained constrs (!inactive_hregs) with
-              None ->
-                let h = spill_constrained constrs i in
-                  iflog cx
-                    (fun _ -> log cx "selected %s to spill and use for <v%d>"
-                       (hr_str h) vreg);
+          let constrs = get_vreg_constraints vreg in
+            match select_constrained constrs (!inactive_hregs) with
+                None ->
+                  let h = spill_constrained constrs i in
+                    iflog cx
+                      (fun _ ->
+                         log cx "selected %s to spill and use for <v%d>"
+                         (hr_str h) vreg);
+                    h
+              | Some h ->
+                  iflog cx (fun _ -> log cx "selected inactive %s for <v%d>"
+                              (hr_str h) vreg);
                   h
-            | Some h ->
-                iflog cx (fun _ -> log cx "selected inactive %s for <v%d>"
-                            (hr_str h) vreg);
-                h
         in
           inactive_hregs :=
             List.filter (fun x -> x != hreg) (!inactive_hregs);
@@ -569,15 +579,15 @@ let reg_alloc
              * This is awful but it saves us from cached/constrained
              * interference as was found in issue #152. *)
             if List.exists
-              (fun v -> not (Bits.equal vreg_constraints.(v) all_hregs))
+              (fun v -> not (Bits.equal (get_vreg_constraints v) all_hregs))
               used
             then
               begin
                 (* Regfence. *)
                 spill_all_regs i;
                 (* Check for over-constrained-ness after any such regfence. *)
                 let vreg_constrs v =
-                  (v, Bits.to_list (vreg_constraints.(v)))
+                  (v, Bits.to_list (get_vreg_constraints v))
                 in
                 let constrs = List.map vreg_constrs (used @ defined) in
                 let constrs_collide (v1,c1) =

trunk/src/boot/be/x86.ml

@@ -385,7 +385,7 @@ let emit_target_specific
 ;;
 
 
-let constrain_vregs (q:Il.quad) (hregs:Bits.t array) : unit =
+let constrain_vregs (q:Il.quad) (hregs:(Il.vreg,Bits.t) Hashtbl.t) : unit =
 
   let involves_8bit_cell =
     let b = ref false in
@@ -402,14 +402,18 @@ let constrain_vregs (q:Il.quad) (hregs:Bits.t array) : unit =
       !b
   in
 
+  let get_hregs v =
+    htab_search_or_add hregs v (fun _ -> Bits.create n_hardregs true)
+  in
+
   let qp_mem _ m = m in
   let qp_cell _ c =
     begin
       match c with
           Il.Reg (Il.Vreg v, _) when involves_8bit_cell ->
             (* 8-bit register cells must only be al, cl, dl, bl.
              * Not esi/edi. *)
-            let hv = hregs.(v) in
+            let hv = get_hregs v in
               List.iter (fun bad -> Bits.set hv bad false) [esi; edi]
         | _ -> ()
     end;
@@ -425,7 +429,7 @@ let constrain_vregs (q:Il.quad) (hregs:Bits.t array) : unit =
                     begin
                       match b.Il.binary_rhs with
                           Il.Cell (Il.Reg (Il.Vreg v, _)) ->
-                            let hv = hregs.(v) in
+                            let hv = get_hregs v in
                               (* Shift src has to be ecx. *)
                               List.iter
                                 (fun bad -> Bits.set hv bad false)