1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
open Xi_lib
open Iface
module type PARAMS = sig
val stop_point : string
val output: string
end
module Make(Steps:COMPILER_STEPS)(Params:PARAMS) = struct
module Hack = Xi_lib.Analysis
open Params
module Toolbox = Steps.Toolbox
module Parser_wrapper = Parser_wrapper.Make(Steps.LexerAndParser)
let check_stop_point name cont x =
if name = stop_point then Ok ()
else cont x
let describe_register_mapping mapping =
let describe_map k v xs =
let entry = Format.sprintf "%s -> %s" (Ir.string_of_reg k) (Ir.string_of_reg v) in
entry :: xs
in
String.concat "\n" @@ Hashtbl.fold describe_map mapping []
let dump_register_mapping proc_ir mapping =
Logger.dump_string "regmapping" @@ describe_register_mapping mapping
let dump_schedule proc_ir schedule =
let title = Format.sprintf "%s.schedule" (Ir_utils.string_of_procid @@ Ir.procid_of_procedure proc_ir) in
let output = Ir_utils.string_of_labellist schedule in
Logger.dump_string title output
module IrPhases = struct
let regalloc proc =
let register_mapping = Steps.RegisterAllocator.regalloc proc in
dump_register_mapping proc register_mapping;
Ir_utils.remap_registers_proc register_mapping proc
let scale_to_program f name ir =
let handle_proc proc =
Logger.new_phase_proc @@ Ir.procid_of_procedure proc;
Measure.measure name (fun () -> f proc);
Logger.dump_ir_proc "final.irproc" proc
in
Measure.measure ("whole " ^ name) (fun () ->
List.iter handle_proc @@ Ir.procedures_of_program ir;
Logger.close_phase_proc ()
);
Logger.dump_ir_program "final.ir" ir
let ir_phases =
[ "jump_threading", scale_to_program Steps.JumpThreading.jump_threading
; "hi_lower", scale_to_program Steps.HiLower.lower
; "constant_folding", scale_to_program Steps.ConstantFolding.fold_constants
; "dead_code_elimination", scale_to_program Steps.DeadCodeElimination.eliminate_dead_code
; "callconv", scale_to_program Steps.CallConv.callconv
; "mips_lower", scale_to_program Steps.MipsLower.lower
; "regalloc", scale_to_program regalloc
; "dead_code_elimination", scale_to_program Steps.DeadCodeElimination.eliminate_dead_code
]
let rec execute_ir_phases ir = function
| [] ->
()
| (name, f)::rest ->
Logger.new_phase name;
f name ir;
execute_ir_phases ir rest
let transform_ir ir =
execute_ir_phases ir ir_phases
end
let finish result =
Format.printf "done\n";
let out = open_out output in
output_string out result;
output_string out "\n";
close_out out;
Ok ()
let codegen ir =
Logger.new_phase "codegen";
let schedule = Toolbox.Scheduler.schedule ir in
Hashtbl.iter dump_schedule schedule;
let assembler = Steps.Codegen.codegen schedule ir in
let result = Hardcoded.preamble ^ Mips32.string_of_program assembler in
Logger.dump_string "final" result;
finish result
let translate (ast, node2type) =
Logger.new_phase "translate";
let ir = Steps.Translator.translate_module ast node2type in
Logger.dump_ir_program "translated.ir" ir;
IrPhases.transform_ir ir;
codegen ir
let type_check ast =
Logger.new_phase "typechecking";
match Steps.Typechecker.check_module ast with
| Error xs ->
let xs = List.map Typechecker_errors.string_of_type_checking_error xs in
List.iter prerr_endline xs;
Error "typechecker"
| Ok (node2type) ->
if Invariants.AllExpressionsAreTypecheck.verify_module_definition node2type ast then
check_stop_point "typechecker" translate (ast, node2type)
else
Error "typechecker"
let parse_step source =
Logger.new_phase "parsing";
match Parser_wrapper.parse_file source with
| Error (loc, descr) ->
Format.printf "%s: %s\n%!" (Ast.string_of_location loc) descr;
Error "parser"
| Ok ok ->
let ast_str = Ast_printer.show_module_definition ok in
Logger.dump_string "ast" ast_str;
let ast_str = Ast_rawprinter.show_module_definition ok in
Logger.dump_string "raw.ast" ast_str;
check_stop_point "parser" type_check ok
let compile =
parse_step
end
|
