260 lines
7.9 KiB
OCaml
260 lines
7.9 KiB
OCaml
(***********************************************************************)
|
|
(* *)
|
|
(* Caml Special Light *)
|
|
(* *)
|
|
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
|
|
(* *)
|
|
(* Copyright 1995 Institut National de Recherche en Informatique et *)
|
|
(* Automatique. Distributed only by permission. *)
|
|
(* *)
|
|
(***********************************************************************)
|
|
|
|
(* $Id$ *)
|
|
|
|
(* Pretty-printing of pseudo machine code *)
|
|
|
|
open Format
|
|
open Cmm
|
|
open Reg
|
|
open Mach
|
|
|
|
let reg r =
|
|
if String.length r.name > 0 then
|
|
print_string r.name
|
|
else
|
|
print_string(match r.typ with Addr -> "A" | Int -> "I" | Float -> "F");
|
|
print_string "/";
|
|
print_int r.stamp;
|
|
begin match r.loc with
|
|
Unknown -> ()
|
|
| Reg r ->
|
|
print_string "["; print_string(Proc.register_name r); print_string "]"
|
|
| Stack(Local s) ->
|
|
print_string "[s"; print_int s; print_string "]"
|
|
| Stack(Incoming s) ->
|
|
print_string "[si"; print_int s; print_string "]"
|
|
| Stack(Outgoing s) ->
|
|
print_string "[so"; print_int s; print_string "]"
|
|
end
|
|
|
|
let regs v =
|
|
match Array.length v with
|
|
0 -> ()
|
|
| 1 -> reg v.(0)
|
|
| n -> reg v.(0);
|
|
for i = 1 to n-1 do print_string " "; reg v.(i) done
|
|
|
|
let regset s =
|
|
let first = ref true in
|
|
Reg.Set.iter
|
|
(fun r ->
|
|
if !first then first := false else print_space();
|
|
reg r)
|
|
s
|
|
|
|
let regsetaddr s =
|
|
let first = ref true in
|
|
Reg.Set.iter
|
|
(fun r ->
|
|
if !first then first := false else print_space();
|
|
reg r;
|
|
match r.typ with Addr -> print_string "*" | _ -> ())
|
|
s
|
|
|
|
let intcomp = function
|
|
Isigned c -> print_string " "; Printcmm.comparison c; print_string "s "
|
|
| Iunsigned c -> print_string " "; Printcmm.comparison c; print_string "u "
|
|
|
|
let floatcomp c =
|
|
print_string " "; Printcmm.comparison c; print_string "f "
|
|
|
|
let intop = function
|
|
Iadd -> print_string " + "
|
|
| Isub -> print_string " - "
|
|
| Imul -> print_string " * "
|
|
| Idiv -> print_string " div "
|
|
| Imod -> print_string " mod "
|
|
| Iand -> print_string " & "
|
|
| Ior -> print_string " | "
|
|
| Ixor -> print_string " ^ "
|
|
| Ilsl -> print_string " << "
|
|
| Ilsr -> print_string " >>u "
|
|
| Iasr -> print_string " >>s "
|
|
| Icomp cmp -> intcomp cmp
|
|
| Icheckbound -> print_string " check > "
|
|
|
|
let test tst arg =
|
|
match tst with
|
|
Itruetest -> reg arg.(0)
|
|
| Ifalsetest -> print_string "not "; reg arg.(0)
|
|
| Iinttest cmp -> reg arg.(0); intcomp cmp; reg arg.(1)
|
|
| Iinttest_imm(cmp, n) -> reg arg.(0); intcomp cmp; print_int n
|
|
| Ifloattest(cmp, neg) ->
|
|
if neg then print_string "not ";
|
|
reg arg.(0); floatcomp cmp; reg arg.(1)
|
|
| Ieventest -> reg arg.(0); print_string " & 1 == 0"
|
|
| Ioddtest -> reg arg.(0); print_string " & 1 == 1"
|
|
|
|
let print_live = ref false
|
|
|
|
let operation op arg res =
|
|
if Array.length res > 0 then begin regs res; print_string " := " end;
|
|
match op with
|
|
Imove -> regs arg
|
|
| Ispill -> regs arg; print_string " (spill)"
|
|
| Ireload -> regs arg; print_string " (reload)"
|
|
| Iconst_int n -> print_int n
|
|
| Iconst_float s -> print_string s
|
|
| Iconst_symbol s -> print_string "\""; print_string s; print_string "\""
|
|
| Icall_ind -> print_string "call "; regs arg
|
|
| Icall_imm lbl ->
|
|
print_string "call \""; print_string lbl;
|
|
print_string "\" "; regs arg
|
|
| Itailcall_ind -> print_string "tailcall "; regs arg
|
|
| Itailcall_imm lbl ->
|
|
print_string "tailcall \""; print_string lbl;
|
|
print_string "\" "; regs arg
|
|
| Iextcall(lbl, alloc) ->
|
|
print_string "extcall \""; print_string lbl;
|
|
print_string "\" "; regs arg;
|
|
if not alloc then print_string " (noalloc)"
|
|
| Istackoffset n ->
|
|
print_string "offset stack "; print_int n
|
|
| Iload(chunk, addr) ->
|
|
Printcmm.chunk chunk;
|
|
print_string "[";
|
|
Arch.print_addressing reg addr arg;
|
|
print_string "]"
|
|
| Istore(chunk, addr) ->
|
|
Printcmm.chunk chunk;
|
|
print_string "[";
|
|
Arch.print_addressing reg addr (Array.sub arg 1 (Array.length arg - 1));
|
|
print_string "] := ";
|
|
reg arg.(0)
|
|
| Ialloc n -> print_string "alloc "; print_int n
|
|
| Iintop(op) -> reg arg.(0); intop op; reg arg.(1)
|
|
| Iintop_imm(op, n) -> reg arg.(0); intop op; print_int n
|
|
| Iaddf -> reg arg.(0); print_string " +f "; reg arg.(1)
|
|
| Isubf -> reg arg.(0); print_string " -f "; reg arg.(1)
|
|
| Imulf -> reg arg.(0); print_string " *f "; reg arg.(1)
|
|
| Idivf -> reg arg.(0); print_string " /f "; reg arg.(1)
|
|
| Ifloatofint -> print_string "floatofint "; reg arg.(0)
|
|
| Iintoffloat -> print_string "intoffloat "; reg arg.(0)
|
|
| Ispecific op ->
|
|
Arch.print_specific_operation reg op arg
|
|
|
|
let rec instr i =
|
|
if !print_live then begin
|
|
open_hovbox 1;
|
|
print_string "{";
|
|
regsetaddr i.live;
|
|
if Array.length i.arg > 0 then begin
|
|
print_space(); print_string "+"; print_space(); regs i.arg
|
|
end;
|
|
print_string "}";
|
|
close_box();
|
|
print_cut()
|
|
end;
|
|
begin match i.desc with
|
|
Iend -> ()
|
|
| Iop op ->
|
|
operation op i.arg i.res
|
|
| Ireturn ->
|
|
print_string "return "; regs i.arg
|
|
| Iifthenelse(tst, ifso, ifnot) ->
|
|
open_vbox 2;
|
|
print_string "if "; test tst i.arg; print_string " then"; print_cut();
|
|
instr ifso;
|
|
begin match ifnot.desc with
|
|
Iend -> ()
|
|
| _ -> print_break 0 (-2); print_string "else"; print_cut(); instr ifnot
|
|
end;
|
|
print_break 0 (-2); print_string "endif";
|
|
close_box()
|
|
| Iswitch(index, cases) ->
|
|
print_string "switch "; reg i.arg.(0);
|
|
for i = 0 to Array.length cases - 1 do
|
|
print_cut();
|
|
open_vbox 2;
|
|
open_hovbox 0;
|
|
for j = 0 to Array.length index - 1 do
|
|
if index.(j) = i then begin
|
|
print_string "case "; print_int j; print_string ":";
|
|
print_cut()
|
|
end
|
|
done;
|
|
close_box(); print_cut();
|
|
instr cases.(i);
|
|
close_box()
|
|
done;
|
|
print_cut(); print_string "endswitch"
|
|
| Iloop(body) ->
|
|
open_vbox 2;
|
|
print_string "loop"; print_cut();
|
|
instr body; print_break 0 (-2);
|
|
print_string "endloop ";
|
|
close_box()
|
|
| Icatch(body, handler) ->
|
|
open_vbox 2;
|
|
print_string "catch"; print_cut();
|
|
instr body;
|
|
print_break 0 (-2); print_string "with"; print_cut();
|
|
instr handler;
|
|
print_break 0 (-2); print_string "endcatch";
|
|
close_box()
|
|
| Iexit ->
|
|
print_string "exit"
|
|
| Itrywith(body, handler) ->
|
|
open_vbox 2;
|
|
print_string "try"; print_cut();
|
|
instr body;
|
|
print_break 0 (-2); print_string "with"; print_cut();
|
|
instr handler;
|
|
print_break 0 (-2); print_string "endtry";
|
|
close_box()
|
|
| Iraise ->
|
|
print_string "raise "; reg i.arg.(0)
|
|
end;
|
|
begin match i.next.desc with
|
|
Iend -> ()
|
|
| _ -> print_cut(); instr i.next
|
|
end
|
|
|
|
let fundecl f =
|
|
open_vbox 2;
|
|
print_string f.fun_name;
|
|
print_string "("; regs f.fun_args; print_string ")";
|
|
print_cut();
|
|
instr f.fun_body;
|
|
close_box()
|
|
|
|
let phase msg f =
|
|
print_string "*** "; print_string msg; print_newline();
|
|
fundecl f; print_newline()
|
|
|
|
let interference r =
|
|
open_hovbox 2;
|
|
reg r; print_string ":";
|
|
List.iter
|
|
(fun r -> print_space(); reg r)
|
|
r.interf;
|
|
close_box();
|
|
print_newline()
|
|
|
|
let interferences () =
|
|
print_string "*** Interferences"; print_newline();
|
|
List.iter interference (Reg.all_registers())
|
|
|
|
let preference r =
|
|
open_hovbox 2;
|
|
reg r; print_string ": ";
|
|
List.iter
|
|
(fun (r, w) -> print_space(); reg r; print_string " weight " ; print_int w)
|
|
r.prefer;
|
|
close_box();
|
|
print_newline()
|
|
|
|
let preferences () =
|
|
print_string "*** Preferences"; print_newline();
|
|
List.iter preference (Reg.all_registers())
|