1995-08-09 08:06:35 -07:00
|
|
|
(***********************************************************************)
|
|
|
|
(* *)
|
2011-07-27 07:17:02 -07:00
|
|
|
(* OCaml *)
|
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
|
|
|
(* *)
|
|
|
|
(***********************************************************************)
|
|
|
|
|
1995-06-15 01:17:29 -07:00
|
|
|
(* Pretty-printing of linearized machine code *)
|
|
|
|
|
2000-04-21 01:13:22 -07:00
|
|
|
open Format
|
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
|
|
|
|
2000-04-21 01:13:22 -07:00
|
|
|
let instr ppf i =
|
2007-01-29 04:11:18 -08:00
|
|
|
begin match i.desc with
|
2000-04-21 01:13:22 -07:00
|
|
|
| Lend -> ()
|
1995-06-15 01:17:29 -07:00
|
|
|
| Lop op ->
|
1995-07-07 05:07:07 -07:00
|
|
|
begin match op with
|
2000-04-21 01:13:22 -07:00
|
|
|
| Ialloc _ | Icall_ind | Icall_imm _ | Iextcall(_, _) ->
|
|
|
|
fprintf ppf "@[<1>{%a}@]@," regsetaddr i.live
|
1995-07-07 05:07:07 -07:00
|
|
|
| _ -> ()
|
|
|
|
end;
|
2000-04-21 01:13:22 -07:00
|
|
|
operation op i.arg ppf i.res
|
1995-08-25 01:46:03 -07:00
|
|
|
| Lreloadretaddr ->
|
2000-04-21 01:13:22 -07:00
|
|
|
fprintf ppf "reload retaddr"
|
1995-06-15 01:17:29 -07:00
|
|
|
| Lreturn ->
|
2000-04-21 01:13:22 -07:00
|
|
|
fprintf ppf "return %a" regs i.arg
|
1995-06-15 01:17:29 -07:00
|
|
|
| Llabel lbl ->
|
2000-04-21 01:13:22 -07:00
|
|
|
fprintf ppf "%a:" label lbl
|
1995-06-15 01:17:29 -07:00
|
|
|
| Lbranch lbl ->
|
2000-04-21 01:13:22 -07:00
|
|
|
fprintf ppf "goto %a" label lbl
|
1995-06-15 01:17:29 -07:00
|
|
|
| Lcondbranch(tst, lbl) ->
|
2000-04-21 01:13:22 -07:00
|
|
|
fprintf ppf "if %a goto %a" (test tst) i.arg label lbl
|
1995-08-12 07:26:23 -07:00
|
|
|
| Lcondbranch3(lbl0, lbl1, lbl2) ->
|
2000-04-21 01:13:22 -07:00
|
|
|
fprintf ppf "switch3 %a" reg i.arg.(0);
|
1995-08-12 07:26:23 -07:00
|
|
|
let case n = function
|
2000-04-21 01:13:22 -07:00
|
|
|
| None -> ()
|
1995-08-12 07:26:23 -07:00
|
|
|
| Some lbl ->
|
2000-04-21 01:13:22 -07:00
|
|
|
fprintf ppf "@,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-04-21 01:13:22 -07:00
|
|
|
fprintf ppf "@,endswitch"
|
1995-06-15 01:17:29 -07:00
|
|
|
| Lswitch lblv ->
|
2000-04-21 01:13:22 -07:00
|
|
|
fprintf ppf "switch %a" reg i.arg.(0);
|
1995-06-15 01:17:29 -07:00
|
|
|
for i = 0 to Array.length lblv - 1 do
|
2000-04-21 01:13:22 -07:00
|
|
|
fprintf ppf "case %i: goto %a" i label lblv.(i)
|
1995-06-15 01:17:29 -07:00
|
|
|
done;
|
2000-04-21 01:13:22 -07:00
|
|
|
fprintf ppf "@,endswitch"
|
1995-07-07 05:07:07 -07:00
|
|
|
| Lsetuptrap lbl ->
|
2000-04-21 01:13:22 -07:00
|
|
|
fprintf ppf "setup trap %a" label lbl
|
1995-07-07 05:07:07 -07:00
|
|
|
| Lpushtrap ->
|
2000-04-21 01:13:22 -07:00
|
|
|
fprintf ppf "push trap"
|
1995-06-15 01:17:29 -07:00
|
|
|
| Lpoptrap ->
|
2000-04-21 01:13:22 -07:00
|
|
|
fprintf ppf "pop trap"
|
1995-06-15 01:17:29 -07:00
|
|
|
| Lraise ->
|
2000-04-21 01:13:22 -07:00
|
|
|
fprintf ppf "raise %a" reg i.arg.(0)
|
2007-01-29 04:11:18 -08:00
|
|
|
end;
|
2012-06-17 01:17:43 -07:00
|
|
|
if not (Debuginfo.is_none i.dbg) then
|
2007-01-29 04:11:18 -08:00
|
|
|
fprintf ppf " %s" (Debuginfo.to_string i.dbg)
|
1995-06-15 01:17:29 -07:00
|
|
|
|
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
|
2000-04-21 01:13:22 -07:00
|
|
|
| Lend -> ()
|
|
|
|
| _ -> fprintf ppf "%a@,%a" instr i all_instr i.next
|
1995-06-15 01:17:29 -07:00
|
|
|
|
2000-04-21 01:13:22 -07:00
|
|
|
let fundecl ppf f =
|
2012-02-21 09:41:02 -08:00
|
|
|
let dbg =
|
|
|
|
if Debuginfo.is_none f.fun_dbg then
|
|
|
|
""
|
|
|
|
else
|
|
|
|
" " ^ Debuginfo.to_string f.fun_dbg in
|
|
|
|
fprintf ppf "@[<v 2>%s:%s@,%a@]" f.fun_name dbg all_instr f.fun_body
|