diff options
Diffstat (limited to 'src/c_backend.ml')
| -rw-r--r-- | src/c_backend.ml | 66 |
1 files changed, 64 insertions, 2 deletions
diff --git a/src/c_backend.ml b/src/c_backend.ml index 31a989f8..5003e432 100644 --- a/src/c_backend.ml +++ b/src/c_backend.ml @@ -72,6 +72,7 @@ let optimize_primops = ref false let optimize_hoist_allocations = ref false let optimize_struct_updates = ref false let optimize_alias = ref false +let optimize_experimental = ref false let c_debug str = if !c_verbosity > 0 then prerr_endline (Lazy.force str) else () @@ -621,7 +622,7 @@ let rec instr_ctyps (I_aux (instr, aux)) = ctyp :: cval_ctyp cval :: List.concat (List.map instr_ctyps instrs1 @ List.map instr_ctyps instrs2) | I_funcall (clexp, _, _, cvals) -> clexp_ctyp clexp :: List.map cval_ctyp cvals - | I_copy (clexp, cval) -> [clexp_ctyp clexp; cval_ctyp cval] + | I_copy (clexp, cval) | I_alias (clexp, cval) -> [clexp_ctyp clexp; cval_ctyp cval] | I_block instrs | I_try_block instrs -> List.concat (List.map instr_ctyps instrs) | I_throw cval | I_jump (cval, _) | I_return cval -> [cval_ctyp cval] | I_comment _ | I_label _ | I_goto _ | I_raw _ | I_match_failure -> [] @@ -1546,7 +1547,7 @@ let rec map_try_block f (I_aux (instr, aux)) = | I_decl _ | I_reset _ | I_init _ | I_reinit _ -> instr | I_if (cval, instrs1, instrs2, ctyp) -> I_if (cval, List.map (map_try_block f) instrs1, List.map (map_try_block f) instrs2, ctyp) - | I_funcall _ | I_copy _ | I_clear _ | I_throw _ | I_return _ -> instr + | I_funcall _ | I_copy _ | I_alias _ | I_clear _ | I_throw _ | I_return _ -> instr | I_block instrs -> I_block (List.map (map_try_block f) instrs) | I_try_block instrs -> I_try_block (f (List.map (map_try_block f) instrs)) | I_comment _ | I_label _ | I_goto _ | I_raw _ | I_jump _ | I_match_failure | I_undefined _ -> instr @@ -1800,6 +1801,7 @@ let rec instrs_rename from_id to_id = | I_aux (I_funcall (clexp, extern, id, cvals), aux) :: instrs -> I_aux (I_funcall (lrename clexp, extern, rename id, List.map crename cvals), aux) :: irename instrs | I_aux (I_copy (clexp, cval), aux) :: instrs -> I_aux (I_copy (lrename clexp, crename cval), aux) :: irename instrs + | I_aux (I_alias (clexp, cval), aux) :: instrs -> I_aux (I_alias (lrename clexp, crename cval), aux) :: irename instrs | I_aux (I_clear (ctyp, id), aux) :: instrs -> I_aux (I_clear (ctyp, rename id), aux) :: irename instrs | I_aux (I_return cval, aux) :: instrs -> I_aux (I_return (crename cval), aux) :: irename instrs | I_aux (I_block block, aux) :: instrs -> I_aux (I_block (irename block), aux) :: irename instrs @@ -2259,6 +2261,62 @@ let combine_variables ctx = [CDEF_fundef (function_id, heap_return, args, opt body)] | cdef -> [cdef] +(** hoist_alias looks for patterns like + + recreate x; y = x; // no furthner mentions of x + + Provided x has a certain type, then we can make y an alias to x + (denoted in the IR as 'alias y = x'). This only works if y also has + a lifespan that also spans the entire function body. It's possible + we may need to do a more thorough lifetime evaluation to get this + to be 100% correct - so it's behind the -Oexperimental flag + for now. Some benchmarking shows that this kind of optimization + is very valuable however! *) +let hoist_alias ctx = + (* Must return true for a subset of the types hoist_ctyp would return true for. *) + let is_struct = function + | CT_struct _ -> true + | _ -> false + in + let pattern heap_return id ctyp instrs = + let rec scan instrs = + match instrs with + (* The only thing that has a longer lifetime than id is the + function return, so we want to make sure we avoid that + case. *) + | (I_aux (I_copy (clexp, (F_id id', ctyp')), aux) as instr) :: instrs + when not (IdSet.mem heap_return (instr_writes instr)) && Id.compare id id' = 0 + && ctyp_equal (clexp_ctyp clexp) ctyp && ctyp_equal ctyp ctyp' -> + if List.exists (IdSet.mem id) (List.map instr_ids instrs) then + instr :: scan instrs + else + I_aux (I_alias (clexp, (F_id id', ctyp')), aux) :: instrs + + | instr :: instrs -> instr :: scan instrs + | [] -> [] + in + scan instrs + in + let optimize heap_return = + let rec opt = function + | (I_aux (I_reset (ctyp, id), _) as instr) :: instrs when not (is_stack_ctyp ctyp) && is_struct ctyp -> + instr :: opt (pattern heap_return id ctyp instrs) + + | I_aux (I_block block, aux) :: instrs -> I_aux (I_block (opt block), aux) :: opt instrs + | I_aux (I_try_block block, aux) :: instrs -> I_aux (I_try_block (opt block), aux) :: opt instrs + | I_aux (I_if (cval, then_instrs, else_instrs, ctyp), aux) :: instrs -> + I_aux (I_if (cval, opt then_instrs, opt else_instrs, ctyp), aux) :: opt instrs + + | instr :: instrs -> + instr :: opt instrs + | [] -> [] + in + opt + in + function + | CDEF_fundef (function_id, Some heap_return, args, body) -> + [CDEF_fundef (function_id, Some heap_return, args, optimize heap_return body)] + | cdef -> [cdef] let concatMap f xs = List.concat (List.map f xs) @@ -2269,6 +2327,7 @@ let optimize ctx cdefs = |> (if !optimize_alias then concatMap (remove_alias ctx) else nothing) |> (if !optimize_alias then concatMap (combine_variables ctx) else nothing) |> (if !optimize_hoist_allocations then concatMap (hoist_allocations ctx) else nothing) + |> (if !optimize_hoist_allocations && !optimize_experimental then concatMap (hoist_alias ctx) else nothing) (**************************************************************************) (* 6. Code generation *) @@ -2395,6 +2454,9 @@ let rec codegen_instr fid ctx (I_aux (instr, (_, l))) = | I_copy (clexp, cval) -> codegen_conversion l clexp cval + | I_alias (clexp, cval) -> + ksprintf string " %s = %s;" (sgen_clexp_pure clexp) (sgen_cval cval) + | I_jump (cval, label) -> ksprintf string " if (%s) goto %s;" (sgen_cval cval) label |