@@ -322,38 +322,34 @@ let dump_quads cx =
322
322
done
323
323
;;
324
324
325
- let calculate_vreg_constraints (cx :ctxt ) : Bits.t array =
325
+ let calculate_vreg_constraints
326
+ (cx :ctxt )
327
+ (constraints :Bits.t array )
328
+ (q :quad )
329
+ : unit =
326
330
let abi = cx.ctxt_abi in
327
- let n_vregs = cx.ctxt_n_vregs in
328
- let n_hregs = abi.Abi. abi_n_hardregs in
329
- let constraints = Array. init n_vregs (fun _ -> Bits. create n_hregs true ) in
330
- Array. iteri
331
+ Array. iter (fun c -> Bits. clear c; Bits. invert c) constraints;
332
+ abi.Abi. abi_constrain_vregs q constraints;
333
+ iflog cx
331
334
begin
332
- fun i q ->
333
- abi.Abi. abi_constrain_vregs q constraints;
334
- iflog cx
335
- begin
336
- fun _ ->
337
- let hr_str = cx.ctxt_abi.Abi. abi_str_of_hardreg in
338
- log cx " constraints for quad %d = %s"
339
- i (string_of_quad hr_str q);
340
- let qp_reg _ r =
341
- begin
342
- match r with
343
- Il. Hreg _ -> ()
344
- | Il. Vreg v ->
345
- let hregs = Bits. to_list constraints.(v) in
346
- log cx " <v%d> constrained to hregs: [%s]"
347
- v (list_to_str hregs hr_str)
348
- end ;
349
- r
350
- in
351
- ignore (Il. process_quad { Il. identity_processor with
352
- Il. qp_reg = qp_reg } q)
353
- end;
335
+ fun _ ->
336
+ let hr_str = cx.ctxt_abi.Abi. abi_str_of_hardreg in
337
+ log cx " constraints for quad %s"
338
+ (string_of_quad hr_str q);
339
+ let qp_reg _ r =
340
+ begin
341
+ match r with
342
+ Il. Hreg _ -> ()
343
+ | Il. Vreg v ->
344
+ let hregs = Bits. to_list constraints.(v) in
345
+ log cx " <v%d> constrained to hregs: [%s]"
346
+ v (list_to_str hregs hr_str)
347
+ end ;
348
+ r
349
+ in
350
+ ignore (Il. process_quad { Il. identity_processor with
351
+ Il. qp_reg = qp_reg } q)
354
352
end
355
- cx.ctxt_quads;
356
- constraints
357
353
;;
358
354
359
355
(* Simple local register allocator. Nothing fancy. *)
@@ -380,8 +376,10 @@ let reg_alloc
380
376
let (live_in_vregs, live_out_vregs) =
381
377
calculate_live_bitvectors cx
382
378
in
379
+ let n_vregs = cx.ctxt_n_vregs in
380
+ let n_hregs = abi.Abi. abi_n_hardregs in
383
381
let (vreg_constraints:Bits.t array ) = (* vreg idx -> hreg bits.t *)
384
- calculate_vreg_constraints cx
382
+ Array. init n_vregs ( fun _ -> Bits. create n_hregs true )
385
383
in
386
384
let inactive_hregs = ref [] in (* [hreg] *)
387
385
let active_hregs = ref [] in (* [hreg] *)
@@ -560,23 +558,40 @@ let reg_alloc
560
558
for i = 0 to (Array. length cx.ctxt_quads) - 1
561
559
do
562
560
let quad = cx.ctxt_quads.(i) in
561
+ let _ = calculate_vreg_constraints cx vreg_constraints quad in
563
562
let clobbers = cx.ctxt_abi.Abi. abi_clobbers quad in
564
563
let used = quad_used_vregs quad in
565
564
let defined = quad_defined_vregs quad in
566
565
567
- let vreg_constrs v = (v, Bits. to_list (vreg_constraints.(v))) in
568
- let used_constrs = List. map vreg_constrs used in
569
- let constrs_collide (v1 ,c1 ) =
570
- if List. length c1 <> 1
571
- then false
572
- else
573
- List. exists
574
- (fun (v2 ,c2 ) -> if v1 = v2 then false else c1 = c2)
575
- used_constrs
576
- in
577
566
begin
578
- if List. exists constrs_collide used_constrs
579
- then raise (Ra_error (" over-constrained vregs" ));
567
+
568
+ (* If the quad has any nontrivial vreg constraints, regfence.
569
+ * This is awful but it saves us from cached/constrained
570
+ * interference as was found in issue #152. *)
571
+ if List. exists
572
+ (fun v -> not (Bits. equal vreg_constraints.(v) all_hregs))
573
+ used
574
+ then
575
+ begin
576
+ (* Regfence. *)
577
+ spill_all_regs i;
578
+ (* Check for over-constrained-ness after any such regfence. *)
579
+ let vreg_constrs v =
580
+ (v, Bits. to_list (vreg_constraints.(v)))
581
+ in
582
+ let constrs = List. map vreg_constrs (used @ defined) in
583
+ let constrs_collide (v1 ,c1 ) =
584
+ if List. length c1 <> 1
585
+ then false
586
+ else
587
+ List. exists
588
+ (fun (v2 ,c2 ) -> if v1 = v2 then false else c1 = c2)
589
+ constrs
590
+ in
591
+ if List. exists constrs_collide constrs
592
+ then raise (Ra_error (" over-constrained vregs" ));
593
+ end ;
594
+
580
595
if List. exists (fun def -> List. mem def clobbers) defined
581
596
then raise (Ra_error (" clobber and defined sets overlap" ));
582
597
iflog cx
@@ -640,10 +655,10 @@ let reg_alloc
640
655
end;
641
656
(cx.ctxt_quads, cx.ctxt_next_spill)
642
657
643
- with
644
- Ra_error s ->
645
- Session. fail sess " RA error: %s\n " s;
646
- (quads, 0 )
658
+ with
659
+ Ra_error s ->
660
+ Session. fail sess " RA error: %s\n " s;
661
+ (quads, 0 )
647
662
648
663
;;
649
664
0 commit comments