114 lines
3.7 KiB
OCaml
114 lines
3.7 KiB
OCaml
(***********************************************************************)
|
|
(* *)
|
|
(* Objective Caml *)
|
|
(* *)
|
|
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
|
|
(* *)
|
|
(* Copyright 1996 Institut National de Recherche en Informatique et *)
|
|
(* en Automatique. All rights reserved. This file is distributed *)
|
|
(* under the terms of the Q Public License version 1.0. *)
|
|
(* *)
|
|
(***********************************************************************)
|
|
|
|
(* $Id$ *)
|
|
|
|
(* From lambda to assembly code *)
|
|
|
|
open Format
|
|
open Config
|
|
open Clflags
|
|
open Misc
|
|
open Cmm
|
|
|
|
type error = Assembler_error of string
|
|
|
|
exception Error of error
|
|
|
|
let liveness ppf phrase =
|
|
Liveness.fundecl ppf phrase; phrase
|
|
|
|
let dump_if ppf flag message phrase =
|
|
if !flag then Printmach.phase message ppf phrase
|
|
|
|
let pass_dump_if ppf flag message phrase =
|
|
dump_if ppf flag message phrase; phrase
|
|
|
|
let pass_dump_linear_if ppf flag message phrase =
|
|
if !flag then fprintf ppf "*** %s@.%a@." message Printlinear.fundecl phrase;
|
|
phrase
|
|
|
|
let rec regalloc ppf round fd =
|
|
if round > 50 then
|
|
fatal_error(fd.Mach.fun_name ^
|
|
": function too complex, cannot complete register allocation");
|
|
dump_if ppf dump_live "Liveness analysis" fd;
|
|
Interf.build_graph fd;
|
|
if !dump_interf then Printmach.interferences ppf ();
|
|
if !dump_prefer then Printmach.preferences ppf ();
|
|
Coloring.allocate_registers();
|
|
dump_if ppf dump_regalloc "After register allocation" fd;
|
|
let (newfd, redo_regalloc) = Reload.fundecl fd in
|
|
dump_if ppf dump_reload "After insertion of reloading code" newfd;
|
|
if redo_regalloc then begin
|
|
Reg.reinit(); Liveness.fundecl ppf newfd; regalloc ppf (round + 1) newfd
|
|
end else newfd
|
|
|
|
let (++) x f = f x
|
|
|
|
let compile_fundecl (ppf : formatter) fd_cmm =
|
|
Reg.reset();
|
|
fd_cmm
|
|
++ Selection.fundecl
|
|
++ pass_dump_if ppf dump_selection "After instruction selection"
|
|
++ Comballoc.fundecl
|
|
++ pass_dump_if ppf dump_combine "After allocation combining"
|
|
++ liveness ppf
|
|
++ pass_dump_if ppf dump_live "Liveness analysis"
|
|
++ Spill.fundecl
|
|
++ liveness ppf
|
|
++ pass_dump_if ppf dump_spill "After spilling"
|
|
++ Split.fundecl
|
|
++ pass_dump_if ppf dump_split "After live range splitting"
|
|
++ liveness ppf
|
|
++ regalloc ppf 1
|
|
++ Linearize.fundecl
|
|
++ pass_dump_linear_if ppf dump_linear "Linearized code"
|
|
++ Scheduling.fundecl
|
|
++ pass_dump_linear_if ppf dump_scheduling "After instruction scheduling"
|
|
++ Emit.fundecl
|
|
|
|
let compile_phrase ppf p =
|
|
if !dump_cmm then fprintf ppf "%a@." Printcmm.phrase p;
|
|
match p with
|
|
| Cfunction fd -> compile_fundecl ppf fd
|
|
| Cdata dl -> Emit.data dl
|
|
|
|
let compile_implementation prefixname ppf (size, lam) =
|
|
let asmfile =
|
|
if !keep_asm_file
|
|
then prefixname ^ ext_asm
|
|
else Filename.temp_file "camlasm" ext_asm in
|
|
let oc = open_out asmfile in
|
|
begin try
|
|
Emitaux.output_channel := oc;
|
|
Emit.begin_assembly();
|
|
Closure.intro size lam
|
|
++ Cmmgen.compunit size
|
|
++ List.iter (compile_phrase ppf) ++ (fun () -> ());
|
|
Emit.end_assembly();
|
|
close_out oc
|
|
with x ->
|
|
close_out oc;
|
|
if !keep_asm_file then () else remove_file asmfile;
|
|
raise x
|
|
end;
|
|
if Proc.assemble_file asmfile (prefixname ^ ext_obj) <> 0
|
|
then raise(Error(Assembler_error asmfile));
|
|
if !keep_asm_file then () else remove_file asmfile
|
|
|
|
(* Error report *)
|
|
|
|
let report_error ppf = function
|
|
| Assembler_error file ->
|
|
fprintf ppf "Assembler error, input left in file %s" file
|