81 lines
2.4 KiB
OCaml
81 lines
2.4 KiB
OCaml
|
(* From lambda to assembly code *)
|
||
|
|
||
|
open Format
|
||
|
open Clflags
|
||
|
open Misc
|
||
|
open Cmm
|
||
|
|
||
|
type error = Assembler_error of string
|
||
|
|
||
|
exception Error of error
|
||
|
|
||
|
let rec regalloc fd =
|
||
|
if !dump_live then Printmach.phase "Liveness analysis" fd;
|
||
|
Interf.build_graph fd;
|
||
|
if !dump_interf then Printmach.interferences();
|
||
|
if !dump_prefer then Printmach.preferences();
|
||
|
Coloring.allocate_registers();
|
||
|
if !dump_regalloc then
|
||
|
Printmach.phase "After register allocation" fd;
|
||
|
let (newfd, redo_regalloc) = Reload.fundecl fd in
|
||
|
if !dump_reload then
|
||
|
Printmach.phase "After insertion of reloading code" newfd;
|
||
|
if redo_regalloc
|
||
|
then begin Reg.reinit(); Liveness.fundecl newfd; regalloc newfd end
|
||
|
else newfd
|
||
|
|
||
|
let compile_fundecl fd_cmm =
|
||
|
Reg.reset();
|
||
|
let fd_sel = Selection.fundecl fd_cmm in
|
||
|
if !dump_selection then
|
||
|
Printmach.phase "After instruction selection" fd_sel;
|
||
|
Liveness.fundecl fd_sel;
|
||
|
if !dump_live then Printmach.phase "Liveness analysis" fd_sel;
|
||
|
let fd_spill = Spill.fundecl fd_sel in
|
||
|
Liveness.fundecl fd_spill;
|
||
|
if !dump_spill then
|
||
|
Printmach.phase "After spilling" fd_spill;
|
||
|
let fd_split = Split.fundecl fd_spill in
|
||
|
Liveness.fundecl fd_split;
|
||
|
if !dump_split then
|
||
|
Printmach.phase "After live range splitting" fd_split;
|
||
|
let fd_reload = regalloc fd_split in
|
||
|
let fd_linear = Linearize.fundecl fd_reload in
|
||
|
if !dump_linear then begin
|
||
|
print_string "*** Linearized code"; print_newline();
|
||
|
Printlinear.fundecl fd_linear; print_newline()
|
||
|
end;
|
||
|
Emit.fundecl fd_linear
|
||
|
|
||
|
let compile_phrase p =
|
||
|
if !dump_cmm then begin Printcmm.phrase p; print_newline() end;
|
||
|
match p with
|
||
|
Cfunction fd -> compile_fundecl fd
|
||
|
| Cdata dl -> Emit.data dl
|
||
|
|
||
|
let compile_implementation prefixname lam =
|
||
|
let asmfile =
|
||
|
if !assembler_only then prefixname ^ ".s" else temp_file "camlasm" ".s" in
|
||
|
let oc = open_out asmfile in
|
||
|
begin try
|
||
|
Emitaux.output_channel := oc;
|
||
|
Emit.begin_assembly();
|
||
|
List.iter compile_phrase (Cmmgen.compunit (Closure.intro lam));
|
||
|
Emit.end_assembly();
|
||
|
close_out oc
|
||
|
with x ->
|
||
|
close_out oc; (*remove_file asmfile;*) raise x
|
||
|
end;
|
||
|
if !assembler_only then () else begin
|
||
|
if Proc.assemble_file asmfile (prefixname ^ ".o") <> 0
|
||
|
then raise(Error(Assembler_error asmfile))
|
||
|
else remove_file asmfile
|
||
|
end
|
||
|
|
||
|
(* Error report *)
|
||
|
|
||
|
let report_error = function
|
||
|
Assembler_error file ->
|
||
|
print_string "Assembler error, input left in file ";
|
||
|
print_string file
|