1995-08-09 08:06:35 -07:00
|
|
|
(***********************************************************************)
|
|
|
|
(* *)
|
1996-04-30 07:53:58 -07:00
|
|
|
(* Objective Caml *)
|
1995-08-09 08:06:35 -07:00
|
|
|
(* *)
|
|
|
|
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
|
|
|
|
(* *)
|
1996-04-30 07:53:58 -07:00
|
|
|
(* Copyright 1996 Institut National de Recherche en Informatique et *)
|
1995-08-09 08:06:35 -07:00
|
|
|
(* Automatique. Distributed only by permission. *)
|
|
|
|
(* *)
|
|
|
|
(***********************************************************************)
|
|
|
|
|
|
|
|
(* $Id$ *)
|
|
|
|
|
1995-06-15 01:17:29 -07:00
|
|
|
(* Pretty-printing of linearized machine code *)
|
|
|
|
|
|
|
|
open Format
|
1995-07-07 05:07:07 -07:00
|
|
|
open Mach
|
1995-06-15 01:17:29 -07:00
|
|
|
open Printmach
|
|
|
|
open Linearize
|
|
|
|
|
|
|
|
let label l =
|
|
|
|
print_string "L"; print_int l
|
|
|
|
|
|
|
|
let instr i =
|
|
|
|
match i.desc with
|
|
|
|
Lend -> ()
|
|
|
|
| Lop op ->
|
1995-07-07 05:07:07 -07:00
|
|
|
begin match op with
|
1995-07-10 02:48:27 -07:00
|
|
|
Ialloc _ | Icall_ind | Icall_imm _ | Iextcall(_, _) ->
|
1995-07-07 05:07:07 -07:00
|
|
|
open_hovbox 1;
|
|
|
|
print_string "{";
|
|
|
|
regsetaddr i.live;
|
|
|
|
print_string "}";
|
|
|
|
close_box();
|
|
|
|
print_cut()
|
|
|
|
| _ -> ()
|
|
|
|
end;
|
1995-06-15 01:17:29 -07:00
|
|
|
operation op i.arg i.res
|
1995-08-25 01:46:03 -07:00
|
|
|
| Lreloadretaddr ->
|
|
|
|
print_string "reload retaddr"
|
1995-06-15 01:17:29 -07:00
|
|
|
| Lreturn ->
|
|
|
|
print_string "return "; regs i.arg
|
|
|
|
| Llabel lbl ->
|
|
|
|
label lbl; print_string ":"
|
|
|
|
| Lbranch lbl ->
|
|
|
|
print_string "goto "; label lbl
|
|
|
|
| Lcondbranch(tst, lbl) ->
|
|
|
|
print_string "if "; test tst i.arg; print_string " goto "; label lbl
|
1995-08-12 07:26:23 -07:00
|
|
|
| Lcondbranch3(lbl0, lbl1, lbl2) ->
|
|
|
|
print_string "switch3 "; reg i.arg.(0);
|
|
|
|
let case n = function
|
|
|
|
None -> ()
|
|
|
|
| Some lbl ->
|
|
|
|
print_cut();
|
|
|
|
print_string "case "; print_int n;
|
|
|
|
print_string ": goto "; label lbl in
|
|
|
|
case 0 lbl0; case 1 lbl1; case 2 lbl2;
|
|
|
|
print_cut(); print_string "endswitch"
|
1995-06-15 01:17:29 -07:00
|
|
|
| Lswitch lblv ->
|
|
|
|
print_string "switch "; reg i.arg.(0);
|
|
|
|
for i = 0 to Array.length lblv - 1 do
|
|
|
|
print_cut();
|
|
|
|
print_string "case "; print_int i;
|
|
|
|
print_string ": goto "; label lblv.(i)
|
|
|
|
done;
|
|
|
|
print_cut(); print_string "endswitch"
|
1995-07-07 05:07:07 -07:00
|
|
|
| Lsetuptrap lbl ->
|
|
|
|
print_string "setup trap "; label lbl
|
|
|
|
| Lpushtrap ->
|
|
|
|
print_string "push trap"
|
1995-06-15 01:17:29 -07:00
|
|
|
| Lpoptrap ->
|
|
|
|
print_string "pop trap"
|
|
|
|
| Lraise ->
|
|
|
|
print_string "raise "; reg i.arg.(0)
|
|
|
|
|
|
|
|
let rec all_instr i =
|
|
|
|
match i.desc with
|
|
|
|
Lend -> ()
|
|
|
|
| _ -> instr i; print_cut(); all_instr i.next
|
|
|
|
|
|
|
|
let fundecl f =
|
|
|
|
open_vbox 2;
|
|
|
|
print_string f.fun_name; print_string ":"; print_cut();
|
|
|
|
all_instr f.fun_body;
|
|
|
|
close_box()
|