233 lines
7.1 KiB
OCaml
233 lines
7.1 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$ *)
|
|
|
|
(* Pretty-printing of pseudo machine code *)
|
|
|
|
open Formatmsg
|
|
open Cmm
|
|
open Reg
|
|
open Mach
|
|
|
|
let register ppf 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");
|
|
printf "/%i" r.stamp;
|
|
begin match r.loc with
|
|
Unknown -> ()
|
|
| Reg r ->
|
|
printf "[%s]" (Proc.register_name r)
|
|
| Stack(Local s) ->
|
|
printf "[s%i]" s
|
|
| Stack(Incoming s) ->
|
|
printf "[si%i]" s
|
|
| Stack(Outgoing s) ->
|
|
printf "[so%i]" s
|
|
end
|
|
|
|
let reg r = printf "%a" register r
|
|
|
|
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_string(Nativeint.to_string n)
|
|
| Iconst_float s -> print_string s
|
|
| Iconst_symbol s -> printf "\"%s\"" s
|
|
| Icall_ind -> print_string "call "; regs arg
|
|
| Icall_imm lbl ->
|
|
printf "call \"%s\" " lbl;
|
|
regs arg
|
|
| Itailcall_ind -> print_string "tailcall "; regs arg
|
|
| Itailcall_imm lbl ->
|
|
printf "tailcall \"%s\" " lbl;
|
|
regs arg
|
|
| Iextcall(lbl, alloc) ->
|
|
printf "extcall \"%s\" " lbl;
|
|
regs arg;
|
|
if not alloc then print_string " (noalloc)"
|
|
| Istackoffset n ->
|
|
printf "offset stack %i" 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 -> printf "alloc %i" n
|
|
| Iintop(op) -> reg arg.(0); intop op; reg arg.(1)
|
|
| Iintop_imm(op, n) -> reg arg.(0); intop op; print_int n
|
|
| Inegf -> print_string "-f "; reg arg.(0)
|
|
| Iabsf -> print_string "absf "; reg arg.(0)
|
|
| 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 instruction ppf i =
|
|
if !print_live then begin
|
|
printf "@[<1>{";
|
|
regsetaddr i.live;
|
|
if Array.length i.arg > 0 then begin
|
|
printf "@ +@ "; regs i.arg
|
|
end;
|
|
printf "}@]@,";
|
|
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) ->
|
|
printf "@[<v 2>if "; test tst i.arg;
|
|
printf " then@,%a" instruction ifso;
|
|
begin match ifnot.desc with
|
|
Iend -> ()
|
|
| _ -> printf "@;<0 -2>else@,%a" instruction ifnot
|
|
end;
|
|
printf "@;<0 -2>endif@]"
|
|
| Iswitch(index, cases) ->
|
|
printf "switch %a" register i.arg.(0);
|
|
for i = 0 to Array.length cases - 1 do
|
|
printf "@,@[<v 2>@[";
|
|
for j = 0 to Array.length index - 1 do
|
|
if index.(j) = i then printf "case %i:@," j
|
|
done;
|
|
printf "@]@,%a@]" instruction cases.(i)
|
|
done;
|
|
printf "@,endswitch"
|
|
| Iloop(body) ->
|
|
printf "@[<v 2>loop@,%a@;<0 -2>endloop@]" instruction body
|
|
| Icatch(body, handler) ->
|
|
printf "@[<v 2>catch@,%a@;<0 -2>with@,%a@;<0 -2>endcatch@]"
|
|
instruction body instruction handler
|
|
| Iexit ->
|
|
print_string "exit"
|
|
| Itrywith(body, handler) ->
|
|
printf "@[<v 2>try@,%a@;<0 -2>with@,%a@;<0 -2>endtry@]"
|
|
instruction body instruction handler
|
|
| Iraise ->
|
|
printf "raise %a" register i.arg.(0)
|
|
end;
|
|
begin match i.next.desc with
|
|
Iend -> ()
|
|
| _ -> printf "@,%a" instruction i.next
|
|
end
|
|
|
|
let functiondecl ppf f =
|
|
printf "@[<v 2>%s(" f.fun_name;
|
|
regs f.fun_args;
|
|
printf ")@,%a@]" instruction f.fun_body
|
|
|
|
let phase msg f =
|
|
printf "*** %s@.%a@." msg functiondecl f
|
|
|
|
let interference r =
|
|
let interf ppf =
|
|
List.iter
|
|
(fun r -> printf "@ %a" register r)
|
|
r.interf in
|
|
printf "@[<2>%a:%t@]@." register r interf
|
|
|
|
let interferences () =
|
|
printf "*** Interferences@.";
|
|
List.iter interference (Reg.all_registers())
|
|
|
|
let preference r =
|
|
let prefs ppf =
|
|
List.iter
|
|
(fun (r, w) -> printf "@ %a weight %i" register r w)
|
|
r.prefer in
|
|
printf "@[<2>%a: %t@]@." register r prefs
|
|
|
|
let preferences () =
|
|
printf "*** Preferences@.";
|
|
List.iter preference (Reg.all_registers())
|
|
|
|
let fundecl d = printf "%a" functiondecl d
|
|
let instr i = printf "%a" instruction i
|