1 (***********************************************************************)
5 (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
7 (* Copyright 1996 Institut National de Recherche en Informatique et *)
8 (* en Automatique. All rights reserved. This file is distributed *)
9 (* under the terms of the Q Public License version 1.0. *)
11 (***********************************************************************)
15 (* From C-- to assembly code *)
20 let dump_cmm = ref false
21 let dump_selection = ref false
22 let dump_live = ref false
23 let dump_spill = ref false
24 let dump_split = ref false
25 let dump_interf = ref false
26 let dump_prefer = ref false
27 let dump_regalloc = ref false
28 let dump_reload = ref false
29 let dump_linear = ref false
32 if !dump_live then Printmach.phase
"Liveness analysis" fd
;
33 Interf.build_graph fd
;
34 if !dump_interf then Printmach.interferences
();
35 if !dump_prefer then Printmach.preferences
();
36 Coloring.allocate_registers
();
37 if !dump_regalloc then
38 Printmach.phase
"After register allocation" fd
;
39 let (newfd
, redo_regalloc
) = Reload.fundecl fd
in
41 Printmach.phase
"After insertion of reloading code" newfd
;
43 then begin Reg.reinit
(); Liveness.fundecl newfd
; regalloc newfd
end
46 let fundecl ppf fd_cmm
=
47 if !dump_cmm then begin
48 fprintf ppf
"*** C-- code@.";
49 fprintf ppf
"%a@." Printcmm.fundecl fd_cmm
52 let fd_sel = Sequence.fundecl fd_cmm
in
53 if !dump_selection then
54 Printmach.phase
"After instruction selection" fd_sel;
55 Liveness.fundecl fd_sel;
56 if !dump_live then Printmach.phase
"Liveness analysis" fd_sel;
57 let fd_spill = Spill.fundecl fd_sel in
58 Liveness.fundecl fd_spill;
60 Printmach.phase
"After spilling" fd_spill;
61 let fd_split = Split.fundecl fd_spill in
62 Liveness.fundecl fd_split;
64 Printmach.phase
"After live range splitting" fd_split;
65 let fd_reload = regalloc fd_split in
66 let fd_linear = Linearize.fundecl fd_reload in
67 if !dump_linear then begin
68 printf
"*** Linearized code@.";
69 Printlinear.fundecl fd_linear; print_newline
()
71 Emit.fundecl fd_linear
74 Cfunction fd
-> fundecl fd
75 | Cdata dl
-> Emit.data dl
78 let ic = open_in filename
in
79 let lb = Lexing.from_channel
ic in
82 phrase(Parsecmm.phrase Lexcmm.token
lb)
88 close_in
ic; Lexcmm.report_error
lb msg
89 | Parsing.Parse_error
->
91 prerr_string
"Syntax error near character ";
92 prerr_int
(Lexing.lexeme_start
lb);
94 | Parsecmmaux.Error msg
->
95 close_in
ic; Parsecmmaux.report_error msg