diff options
Diffstat (limited to 'source')
-rw-r--r-- | source/mod_student/plugin.ml | 7 | ||||
-rw-r--r-- | source/mod_student/regalloc.ml | 185 | ||||
-rw-r--r-- | source/xi/plugin_manager.ml | 11 | ||||
-rw-r--r-- | source/xi/xi.ml | 2 | ||||
-rw-r--r-- | source/xi_lib/hardcoded.ml | 6 | ||||
-rw-r--r-- | source/xi_lib/iface.ml | 8 | ||||
-rw-r--r-- | source/xi_lib/plugin.ml | 5 |
7 files changed, 217 insertions, 7 deletions
diff --git a/source/mod_student/plugin.ml b/source/mod_student/plugin.ml index 33e2f27..ff5016e 100644 --- a/source/mod_student/plugin.ml +++ b/source/mod_student/plugin.ml @@ -38,7 +38,10 @@ module Plugin : PLUGIN = struct let make_typechecker = Some (module Typechecker.Make : MAKE_TYPECHECKER) *) + let make_translator = None + (* let make_translator = Some (module Translator.Make : MAKE_TRANSLATOR) + *) let make_jump_threading = None @@ -50,7 +53,9 @@ module Plugin : PLUGIN = struct let make_mipslower = None - let make_register_allocator = None + let make_register_allocator = Some (module Regalloc.Make : MAKE_REGISTER_ALLOCATOR) + + let make_register_coalescing = None let make_constant_folding_analysis = None diff --git a/source/mod_student/regalloc.ml b/source/mod_student/regalloc.ml new file mode 100644 index 0000000..7e717fc --- /dev/null +++ b/source/mod_student/regalloc.ml @@ -0,0 +1,185 @@ +open Xi_lib +open Xi_lib.Measure +open Ir + +let logf fmt = Logger.make_logf __MODULE__ fmt + +module Make(Toolbox:Iface.COMPILER_TOOLBOX) = struct + + module Implementation(M:sig + val cfg: ControlFlowGraph.t + val proc: procedure + end) = struct + + open M + + module Coalescencing = Toolbox.RegisterCoalescing + + (* Dostępne rejestry *) + let available_registers = Toolbox.RegistersDescription.available_registers + + (* Liczba dostępnych kolorów *) + let number_of_available_registers = List.length available_registers + + (* ------------------------------------------------------------------------ + * Hashtablice z kolorami + *) + + (* wstępnie pokolorowane wierzchołki *) + let base_register2color_assignment : (reg, int) Hashtbl.t = Hashtbl.create 13 + + (* kolory wierzchołków *) + let register2color_assignment : (reg, int) Hashtbl.t = Hashtbl.create 13 + + (* pomocnicza tablica -- odwzorowuje kolor na rejestr sprzętowy *) + let color2register_assignment : (int, reg) Hashtbl.t = Hashtbl.create 13 + + (* ------------------------------------------------------------------------ + * Wstępne kolorowanie + *) + + let initialize_colors () = + let color i hard = + Hashtbl.replace color2register_assignment i hard; + Hashtbl.replace base_register2color_assignment hard i; + in + List.iteri color available_registers + + (* ------------------------------------------------------------------------ + * Budowanie grafu interferencji + *) + + let build_infg () = + logf "building interference graph"; + let lva = Toolbox.LiveVariablesAnalysis.analyse cfg in + Logger.extra_debug begin fun () -> + Logger.dump_live_variables "before-inf-build" cfg lva; + end; + let infg = Toolbox.InterferenceGraphAnalysis.analyse cfg lva in + Logger.extra_debug begin fun () -> + Logger.dump_interference_graph "before-simplify" infg + end; + infg + + (* ------------------------------------------------------------------------ + * Pomocnicze funkcje + *) + + let loop name f = + let rec iter i = + logf "Starting iteration %s %u" name i; + let r, should_restart = measure "iteration" f in + if should_restart then + iter (succ i) + else + r + in + iter 0 + + (* ------------------------------------------------------------------------ + * Spilling + *) + + let compute_spill_costs infg = + Logger.extra_debug begin fun () -> + logf "Computing dominators" + end; + let dom = Toolbox.DominatorsAnalysis.analyse cfg in + Logger.extra_debug begin fun () -> + logf "Computing natural-loops" + end; + let nloops = Toolbox.NaturalLoopsAnalysis.analyse cfg dom in + Logger.extra_debug begin fun () -> + logf "Computing spill-costs" + end; + let spill_costs = Toolbox.SpillCostsAnalysis.analyse cfg nloops in + Logger.extra_debug begin fun () -> + Logger.dump_spill_costs spill_costs; + end; + spill_costs + + let spill actual_spills = + measure "spill" (fun () -> Toolbox.Spilling.spill proc actual_spills); + actual_spills <> [] + + (* ------------------------------------------------------------------------ + * Faza simplify + *) + + + let simplify = + failwith "not yet implemented" + + (* ------------------------------------------------------------------------ + * Faza Select + *) + + let select = + failwith "not yet implemented" + + (* ------------------------------------------------------------------------ + * Pętla build-coalesce + *) + + let build_coalescence () = + let infg = measure "build" (fun () -> build_infg ()) in + let changed = measure "coalescence" (fun () -> Coalescencing.coalesce proc infg available_registers) in + infg, changed + + let build_coalescence_loop () = + loop "build-coalescence" build_coalescence + + (* ------------------------------------------------------------------------ + * Pętla build-coalesce + *) + + let single_pass () = + let init () = begin + (* resetujemy robocze tablice *) + Hashtbl.reset register2color_assignment; + Hashtbl.replace_seq register2color_assignment @@ Hashtbl.to_seq base_register2color_assignment; + end in + Logger.extra_debug begin fun () -> + Logger.dump_ir_proc "begin-loop" proc + end; + let init = measure "init" init in + let infg = measure "build-coalescence " build_coalescence_loop in + let spill_costs = measure "spillcosts" (fun () -> compute_spill_costs infg) in + (* uruchom fazę simplify/select/spill *) + + (* unit na potrzeby interfejsu pomocniczej funkcji loop *) + (), true + + (* ------------------------------------------------------------------------ + * Budowanie mapowania rejestrów + *) + + let build_register_assignment () = + let register_assignment : (reg, reg) Hashtbl.t = Hashtbl.create 513 in + failwith "not yet implemented"; + (* Przejdz tablice register2color_assignment i uzupełnij prawidłowo + * tablicę register_assignment *) + register_assignment + + (* ------------------------------------------------------------------------ + * Main + *) + + let regalloc () = + logf "Starting register-allocation"; + initialize_colors (); + loop "main-loop" single_pass; + build_register_assignment () + + end + + let regalloc proc = + let module Instance = Implementation(struct + let cfg = cfg_of_procedure proc + let proc = proc + let available_registers = Toolbox.RegistersDescription.available_registers + end) + in + Instance.regalloc () + +end diff --git a/source/xi/plugin_manager.ml b/source/xi/plugin_manager.ml index 3c6cdf0..7b1c8db 100644 --- a/source/xi/plugin_manager.ml +++ b/source/xi/plugin_manager.ml @@ -95,6 +95,13 @@ module Getters = struct | Some x -> Some (name, Plugin.version, x) | None -> None + let make_register_coalescing (name, plugin) = + let module Plugin = (val plugin : Plugin.PLUGIN) in + match Plugin.make_register_coalescing with + | Some x -> Some (name, Plugin.version, x) + | None -> None + + let make_dead_code_elimination (name, plugin) = let module Plugin = (val plugin : Plugin.PLUGIN) in match Plugin.make_dead_code_elimination with @@ -169,6 +176,8 @@ module Resolver = struct let make_register_allocator = find_module "MakeRegisterAllocator" Getters.make_register_allocator + let make_register_coalescing = find_module "MakeRegisterCoalescing" Getters.make_register_coalescing + let make_dead_code_elimination = find_module "MakeDeadCodeElimination" Getters.make_dead_code_elimination let make_codegen = find_module "MakeCodegen" Getters.make_codegen @@ -191,6 +200,7 @@ let resolve_compiler_toolbox regdescr = let module MakeInterferenceGraphAnalysis = (val Resolver.make_interference_graph_analysis !register) in let module MakeSpilling = (val Resolver.make_spilling !register) in let module MakeReachabilityAnalysis = (val Resolver.make_reachability_analysis !register) in + let module MakeRegisterCoalescing = (val Resolver.make_register_coalescing !register) in let module M = struct module LiveVariablesAnalysis = MakeLiveVariablesAnalysis() module DominatorsAnalysis = MakeDominatorsAnalysis() @@ -202,6 +212,7 @@ let resolve_compiler_toolbox regdescr = module InterferenceGraphAnalysis = MakeInterferenceGraphAnalysis() module Spilling = MakeSpilling() module ReachabilityAnalysis = MakeReachabilityAnalysis() + module RegisterCoalescing = MakeRegisterCoalescing() end in (module M : Iface.COMPILER_TOOLBOX) diff --git a/source/xi/xi.ml b/source/xi/xi.ml index c54a499..aca4997 100644 --- a/source/xi/xi.ml +++ b/source/xi/xi.ml @@ -72,7 +72,7 @@ module CommandLine = struct let cmd = let doc = "Compile Xi Program" in - let version = "pracownia3.1-0-g147dd61" in + let version = "pracownia4.1-0-ge52fd94" in Term.(const compile $ xi_log $ extra_debug $ mod_uwr $ plugin $ reg_descr $ stop_after $ output $ source_file), Term.info "xi" ~doc ~version diff --git a/source/xi_lib/hardcoded.ml b/source/xi_lib/hardcoded.ml index 314fa1f..37cf1d7 100644 --- a/source/xi_lib/hardcoded.ml +++ b/source/xi_lib/hardcoded.ml @@ -35,10 +35,6 @@ let preamble = String.concat "\n" ; " add $sp, $sp, 4" ; " jr $ra" ; "" - ; "_xi_length:" - ; " lw $v0, -4($a0)" - ; " jr $ra" - ; "" ; "_xi_concat:" ; " # t0 = lhs" ; " # t1 = rhs" @@ -119,4 +115,4 @@ let preamble = String.concat "\n" ; " jr $ra" ; "" ; "" - ]
\ No newline at end of file + ] diff --git a/source/xi_lib/iface.ml b/source/xi_lib/iface.ml index 04658e0..6f139f6 100644 --- a/source/xi_lib/iface.ml +++ b/source/xi_lib/iface.ml @@ -64,6 +64,12 @@ module type CALLCONV = sig end +module type REGISTER_COALESCING = sig + + val coalesce: Ir.procedure -> Ir.RegGraph.t -> Ir.reg list -> bool + +end + module type REGISTER_ALLOCATOR = sig val regalloc: Ir.procedure -> register_mapping @@ -168,6 +174,8 @@ module type COMPILER_TOOLBOX = sig module Spilling : SPILLING module ReachabilityAnalysis : REACHABILITY_ANALYSIS + + module RegisterCoalescing: REGISTER_COALESCING end diff --git a/source/xi_lib/plugin.ml b/source/xi_lib/plugin.ml index 33e6e4e..7069924 100644 --- a/source/xi_lib/plugin.ml +++ b/source/xi_lib/plugin.ml @@ -39,6 +39,9 @@ module type MAKE_MIPS_LOWER = functor (T:COMPILER_TOOLBOX) -> MIPS_LOWER module type MAKE_SPILLING = functor () -> SPILLING +module type MAKE_REGISTER_COALESCING = functor () -> REGISTER_COALESCING + + module type PLUGIN = sig val version: string @@ -82,4 +85,6 @@ module type PLUGIN = sig val make_spilling: (module MAKE_SPILLING) option val make_reachability_analysis: (module MAKE_REACHABILITY_ANALYSIS) option + + val make_register_coalescing: (module MAKE_REGISTER_COALESCING ) option end
\ No newline at end of file |