1(**************************************************************************) 2(* *) 3(* OCaml *) 4(* *) 5(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 6(* Mark Shinwell, Jane Street Europe *) 7(* *) 8(* Copyright 1996 Institut National de Recherche en Informatique et *) 9(* en Automatique. *) 10(* *) 11(* All rights reserved. This file is distributed under the terms of *) 12(* the GNU Lesser General Public License version 2.1, with the *) 13(* special exception on linking described in the file LICENSE. *) 14(* *) 15(**************************************************************************) 16 17open Mach 18open Linearize 19 20module Make (T : Branch_relaxation_intf.S) = struct 21 let label_map code = 22 let map = Hashtbl.create 37 in 23 let rec fill_map pc instr = 24 match instr.desc with 25 | Lend -> (pc, map) 26 | Llabel lbl -> Hashtbl.add map lbl pc; fill_map pc instr.next 27 | op -> fill_map (pc + T.instr_size op) instr.next 28 in 29 fill_map 0 code 30 31 let branch_overflows map pc_branch lbl_dest max_branch_offset = 32 let pc_dest = Hashtbl.find map lbl_dest in 33 let delta = pc_dest - (pc_branch + T.offset_pc_at_branch) in 34 delta <= -max_branch_offset || delta >= max_branch_offset 35 36 let opt_branch_overflows map pc_branch opt_lbl_dest max_branch_offset = 37 match opt_lbl_dest with 38 | None -> false 39 | Some lbl_dest -> 40 branch_overflows map pc_branch lbl_dest max_branch_offset 41 42 let instr_overflows ~code_size ~max_out_of_line_code_offset instr map pc = 43 match T.Cond_branch.classify_instr instr.desc with 44 | None -> false 45 | Some branch -> 46 let max_branch_offset = 47 (* Remember to cut some slack for multi-word instructions (in the 48 [Linearize] sense of the word) where the branch can be anywhere in 49 the middle. 12 words of slack is plenty. *) 50 T.Cond_branch.max_displacement branch - 12 51 in 52 match instr.desc with 53 | Lop (Ialloc _) 54 | Lop (Iintop (Icheckbound _)) 55 | Lop (Iintop_imm (Icheckbound _, _)) 56 | Lop (Ispecific _) -> 57 (* We assume that any branches eligible for relaxation generated 58 by these instructions only branch forward. We further assume 59 that any of these may branch to an out-of-line code block. *) 60 code_size + max_out_of_line_code_offset - pc >= max_branch_offset 61 | Lcondbranch (_, lbl) -> 62 branch_overflows map pc lbl max_branch_offset 63 | Lcondbranch3 (lbl0, lbl1, lbl2) -> 64 opt_branch_overflows map pc lbl0 max_branch_offset 65 || opt_branch_overflows map pc lbl1 max_branch_offset 66 || opt_branch_overflows map pc lbl2 max_branch_offset 67 | _ -> 68 Misc.fatal_error "Unsupported instruction for branch relaxation" 69 70 let fixup_branches ~code_size ~max_out_of_line_code_offset map code = 71 let expand_optbranch lbl n arg next = 72 match lbl with 73 | None -> next 74 | Some l -> 75 instr_cons (Lcondbranch (Iinttest_imm (Isigned Cmm.Ceq, n), l)) 76 arg [||] next 77 in 78 let rec fixup did_fix pc instr = 79 match instr.desc with 80 | Lend -> did_fix 81 | _ -> 82 let overflows = 83 instr_overflows ~code_size ~max_out_of_line_code_offset instr map pc 84 in 85 if not overflows then 86 fixup did_fix (pc + T.instr_size instr.desc) instr.next 87 else 88 match instr.desc with 89 | Lop (Ialloc { words = num_words; label_after_call_gc; }) -> 90 instr.desc <- T.relax_allocation ~num_words ~label_after_call_gc; 91 fixup true (pc + T.instr_size instr.desc) instr.next 92 | Lop (Iintop (Icheckbound { label_after_error; })) -> 93 instr.desc <- T.relax_intop_checkbound ~label_after_error; 94 fixup true (pc + T.instr_size instr.desc) instr.next 95 | Lop (Iintop_imm (Icheckbound { label_after_error; }, bound)) -> 96 instr.desc 97 <- T.relax_intop_imm_checkbound ~bound ~label_after_error; 98 fixup true (pc + T.instr_size instr.desc) instr.next 99 | Lop (Ispecific specific) -> 100 instr.desc <- T.relax_specific_op specific; 101 fixup true (pc + T.instr_size instr.desc) instr.next 102 | Lcondbranch (test, lbl) -> 103 let lbl2 = Cmm.new_label() in 104 let cont = 105 instr_cons (Lbranch lbl) [||] [||] 106 (instr_cons (Llabel lbl2) [||] [||] instr.next) 107 in 108 instr.desc <- Lcondbranch (invert_test test, lbl2); 109 instr.next <- cont; 110 fixup true (pc + T.instr_size instr.desc) instr.next 111 | Lcondbranch3 (lbl0, lbl1, lbl2) -> 112 let cont = 113 expand_optbranch lbl0 0 instr.arg 114 (expand_optbranch lbl1 1 instr.arg 115 (expand_optbranch lbl2 2 instr.arg instr.next)) 116 in 117 instr.desc <- cont.desc; 118 instr.next <- cont.next; 119 fixup true pc instr 120 | _ -> 121 (* Any other instruction has already been rejected in 122 [instr_overflows] above. 123 We can *never* get here. *) 124 assert false 125 in 126 fixup false 0 code 127 128 (* Iterate branch expansion till all conditional branches are OK *) 129 130 let rec relax code ~max_out_of_line_code_offset = 131 let min_of_max_branch_offsets = 132 List.fold_left (fun min_of_max_branch_offsets branch -> 133 min min_of_max_branch_offsets 134 (T.Cond_branch.max_displacement branch)) 135 max_int T.Cond_branch.all 136 in 137 let (code_size, map) = label_map code in 138 if code_size >= min_of_max_branch_offsets 139 && fixup_branches ~code_size ~max_out_of_line_code_offset map code 140 then relax code ~max_out_of_line_code_offset 141 else () 142end 143