@@ -407,6 +407,85 @@ let expand_builtin_inline name args res =
407407 | _ ->
408408 raise (Error (" unrecognized builtin " ^ name))
409409
410+ (* Number of statements in a piece of inline assembly code.
411+ This gives an upper bound on the number of machine instructions.
412+ (Some statements can be labels or directives.) *)
413+
414+ let re_asm_comment = Str. regexp " \\ (//\\ |^#\\ ).*$" (* // or # at BOL *)
415+ let re_blank_line = Str. regexp " ^[ \t ]*\n "
416+ let re_asm_stmt_separator = Str. regexp " [\n ;]" (* newline or ; *)
417+
418+ let num_statements_inline_asm txt =
419+ txt |> Str. global_replace re_asm_comment " "
420+ |> Str. global_replace re_blank_line " "
421+ |> Str. split re_asm_stmt_separator
422+ |> List. length
423+
424+ (* Branch relaxation *)
425+
426+ module BInfo : BRANCH_INFORMATION = struct
427+
428+ let builtin_size = function
429+ | EF_annot _ -> 0
430+ | EF_debug _ -> 0
431+ | EF_inline_asm (txt , _ , _ ) -> 4 * num_statements_inline_asm txt
432+ | _ -> assert false
433+
434+ let instr_size = function
435+ | Pfmovimmd _ | Pfmovimms _ -> 8
436+ | Ploadsymbol _ -> 2
437+ | Pbtbl (_ , tbl ) -> 12 + 4 * List. length tbl
438+ | Plabel _ | Pcfi_adjust _ | Pcfi_rel_offset _ -> 0
439+ | Pbuiltin (ef , _ , _ ) -> builtin_size ef
440+ | _ -> 4
441+
442+ let branch_overflow ~map pc lbl range =
443+ let displ = pc + 4 - map lbl in
444+ displ < - range || displ > = range
445+
446+ let need_relaxation ~map pc instr =
447+ match instr with
448+ | Pbc (_ , lbl ) | Pcbnz (_ , _ , lbl ) | Pcbz (_ , _ , lbl ) ->
449+ (* +/- 1 MB *)
450+ branch_overflow ~map pc lbl 0x100_000
451+ | Ptbnz (_ , _ , _ , lbl ) | Ptbz (_ , _ , _ , lbl ) ->
452+ (* +/- 32 KB *)
453+ branch_overflow ~map pc lbl 0x8_000
454+ | _ ->
455+ false
456+
457+ let negate_testcond = function
458+ | TCeq -> TCne | TCne -> TCeq
459+ | TChs -> TClo | TClo -> TChs
460+ | TCmi -> TCpl | TCpl -> TCmi
461+ | TChi -> TCls | TCls -> TChi
462+ | TCge -> TClt | TClt -> TCge
463+ | TCgt -> TCle | TCle -> TCgt
464+
465+ let relax_instruction instr =
466+ match instr with
467+ | Pbc (c , lbl ) ->
468+ let lbl' = new_label() in
469+ [Pbc (negate_testcond c, lbl'); Pb lbl; Plabel lbl']
470+ | Pcbnz (sz , r , lbl ) ->
471+ let lbl' = new_label() in
472+ [Pcbz (sz, r, lbl'); Pb lbl; Plabel lbl']
473+ | Pcbz (sz , r , lbl ) ->
474+ let lbl' = new_label() in
475+ [Pcbnz (sz, r, lbl'); Pb lbl; Plabel lbl']
476+ | Ptbnz (sz , r , n , lbl ) ->
477+ let lbl' = new_label() in
478+ [Ptbz (sz, r, n, lbl'); Pb lbl; Plabel lbl']
479+ | Ptbz (sz , r , n , lbl ) ->
480+ let lbl' = new_label() in
481+ [Ptbnz (sz, r, n, lbl'); Pb lbl; Plabel lbl']
482+ | _ ->
483+ assert false
484+
485+ end
486+
487+ module BRelax = Branch_relaxation (BInfo )
488+
410489(* Expansion of instructions *)
411490
412491let expand_instruction instr =
@@ -478,7 +557,8 @@ let expand_function id fn =
478557 try
479558 set_current_function fn;
480559 expand id (* sp= *) 31 preg_to_dwarf expand_instruction fn.fn_code;
481- Errors. OK (get_current_function () )
560+ let fn' = BRelax. relaxation (get_current_function () ) in
561+ Errors. OK fn'
482562 with Error s ->
483563 Errors. Error (Errors. msg s)
484564
0 commit comments