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 *)
|
1999-11-17 10:59:06 -08:00
|
|
|
(* en Automatique. All rights reserved. This file is distributed *)
|
|
|
|
(* under the terms of the Q Public License version 1.0. *)
|
1995-08-09 08:06:35 -07:00
|
|
|
(* *)
|
|
|
|
(***********************************************************************)
|
|
|
|
|
|
|
|
(* $Id$ *)
|
|
|
|
|
1995-06-15 01:17:29 -07:00
|
|
|
(* Pretty-printing of linearized machine code *)
|
|
|
|
|
1999-11-08 09:06:33 -08:00
|
|
|
open Formatmsg
|
1995-07-07 05:07:07 -07:00
|
|
|
open Mach
|
1995-06-15 01:17:29 -07:00
|
|
|
open Printmach
|
|
|
|
open Linearize
|
|
|
|
|
2000-02-08 12:00:06 -08:00
|
|
|
let label ppf l =
|
|
|
|
Format.fprintf ppf "L%i" l
|
1995-06-15 01:17:29 -07:00
|
|
|
|
|
|
|
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(_, _) ->
|
2000-02-08 12:00:06 -08:00
|
|
|
printf "@[<1>{";
|
1995-07-07 05:07:07 -07:00
|
|
|
regsetaddr i.live;
|
2000-02-08 12:00:06 -08:00
|
|
|
printf "}@]@,"
|
1995-07-07 05:07:07 -07:00
|
|
|
| _ -> ()
|
|
|
|
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 ->
|
2000-02-08 12:00:06 -08:00
|
|
|
printf "%a:" label lbl
|
1995-06-15 01:17:29 -07:00
|
|
|
| Lbranch lbl ->
|
2000-02-08 12:00:06 -08:00
|
|
|
printf "goto %a" label lbl
|
1995-06-15 01:17:29 -07:00
|
|
|
| Lcondbranch(tst, lbl) ->
|
2000-02-08 12:00:06 -08:00
|
|
|
printf "if "; test tst i.arg; printf " goto %a" 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 ->
|
2000-02-08 12:00:06 -08:00
|
|
|
printf "@,case %i: goto %a" n label lbl in
|
1995-08-12 07:26:23 -07:00
|
|
|
case 0 lbl0; case 1 lbl1; case 2 lbl2;
|
2000-02-08 12:00:06 -08:00
|
|
|
printf "@,endswitch"
|
1995-06-15 01:17:29 -07:00
|
|
|
| Lswitch lblv ->
|
2000-02-08 12:00:06 -08:00
|
|
|
printf "switch "; reg i.arg.(0);
|
1995-06-15 01:17:29 -07:00
|
|
|
for i = 0 to Array.length lblv - 1 do
|
2000-02-08 12:00:06 -08:00
|
|
|
printf "case %i: goto %a" i label lblv.(i)
|
1995-06-15 01:17:29 -07:00
|
|
|
done;
|
2000-02-08 12:00:06 -08:00
|
|
|
printf "@,endswitch"
|
1995-07-07 05:07:07 -07:00
|
|
|
| Lsetuptrap lbl ->
|
2000-02-08 12:00:06 -08:00
|
|
|
printf "setup trap %a" label lbl
|
1995-07-07 05:07:07 -07:00
|
|
|
| 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)
|
|
|
|
|
2000-02-08 12:00:06 -08:00
|
|
|
let rec all_instr ppf i =
|
1995-06-15 01:17:29 -07:00
|
|
|
match i.desc with
|
|
|
|
Lend -> ()
|
2000-02-08 12:00:06 -08:00
|
|
|
| _ -> instr i; printf "@,%a" all_instr i.next
|
1995-06-15 01:17:29 -07:00
|
|
|
|
|
|
|
let fundecl f =
|
2000-02-08 12:00:06 -08:00
|
|
|
printf "@[<v 2>%s:@,%a@]" f.fun_name all_instr f.fun_body
|