pretty print vtables (again)

This commit is contained in:
tali 2023-12-23 14:35:18 -05:00
parent f3954e6ca5
commit 605698e13b
2 changed files with 47 additions and 21 deletions

View File

@ -10,7 +10,7 @@ let () =
val one = 1 val one = 1
fun twice(x) { fun twice(x) {
fun f(x) (x - one) * two fun f(x) (x - one) * two
fun g() x + one fun g() if (x == one) two else (x + one)
f(g()) f(g())
} }
println(twice(4)) println(twice(4))

View File

@ -176,18 +176,6 @@ let pp_loc ppf = function
| (r, (#reg as i)) -> Fmt.pf ppf "%a[%a]" pp_reg r pp_reg i | (r, (#reg as i)) -> Fmt.pf ppf "%a[%a]" pp_reg r pp_reg i
| (r, `Ofs ofs) -> Fmt.pf ppf "%a[%d]" pp_reg r ofs | (r, `Ofs ofs) -> Fmt.pf ppf "%a[%d]" pp_reg r ofs
let pp_vtable ppf (vtb : Value.vtable) =
Fmt.pf ppf "(%d){" vtb.n_slots;
let sep = ref "" in
Hashtbl.iter
(fun name -> function
| Value.Method _ -> ()
| Value.Field idx ->
Fmt.pf ppf "%s%s=%d" !sep name idx;
sep := ",")
vtb.elems;
Fmt.pf ppf "}"
let string_of_cnd ~prefix = function let string_of_cnd ~prefix = function
| EQ -> prefix ^ "eq" | EQ -> prefix ^ "eq"
| GT -> prefix ^ "gt" | GT -> prefix ^ "gt"
@ -206,13 +194,23 @@ let string_of_opr = function
let pp_i0 ppf = function let pp_i0 ppf = function
| Ret a -> Fmt.pf ppf "ret %a" pp_arg a | Ret a -> Fmt.pf ppf "ret %a" pp_arg a
let pp_i1 ppf = function let pp_i1 ~vtbname ppf = function
| Mov (a, b) -> Fmt.pf ppf "mov %a, %a" pp_reg a pp_arg b | Mov (a, b) -> Fmt.pf ppf "mov %a, %a" pp_reg a pp_arg b
| Opr (o, a, b) -> Fmt.pf ppf "%s %a, %a" (string_of_opr o) pp_reg a pp_arg b | Opr (o, a, b) -> Fmt.pf ppf "%s %a, %a" (string_of_opr o) pp_reg a pp_arg b
| Get (a, b) -> Fmt.pf ppf "mov %a, %a" pp_reg a pp_loc b | Get (a, b) -> Fmt.pf ppf "mov %a, %a" pp_reg a pp_loc b
| Set (a, b) -> Fmt.pf ppf "mov %a, %a" pp_loc a pp_arg b | Set (a, b) -> Fmt.pf ppf "mov %a, %a" pp_loc a pp_arg b
| Loc (a, b, nam) -> Fmt.pf ppf "loc %a, %a.<%s>" pp_reg a pp_reg b nam | Loc (a, b, nam) -> Fmt.pf ppf "loc %a, %a.<%s>" pp_reg a pp_reg b nam
| Con (a, vtb) -> Fmt.pf ppf "con %a, %a" pp_reg a pp_vtable vtb | Con (a, vtb) ->
Fmt.pf ppf "con %a, %s(%d){" pp_reg a (vtbname vtb) vtb.n_slots;
let sep = ref "" in
Hashtbl.iter
(fun name -> function
| Value.Method _ -> ()
| Value.Field idx ->
Fmt.pf ppf "%s%s=%d" !sep name idx;
sep := ",")
vtb.elems;
Fmt.pf ppf "}"
| Cal (r, f, args) -> | Cal (r, f, args) ->
Fmt.pf ppf "cal %a, %a(" pp_reg r pp_loc f; Fmt.pf ppf "cal %a, %a(" pp_reg r pp_loc f;
List.iteri (fun i a -> if i > 0 then Fmt.pf ppf ","; pp_reg ppf a) args; List.iteri (fun i a -> if i > 0 then Fmt.pf ppf ","; pp_reg ppf a) args;
@ -239,10 +237,20 @@ let generate_labels ep =
| I2 (_, t1, t2) -> go t1 false; go t2 true | I2 (_, t1, t2) -> go t1 false; go t2 true
end end
in in
ep.label <- Some "EP"; (* ep.label <- Some "EP"; *)
go ep false go ep false
let dump ?(margin = 8) println main = let dump ?(recursive = true) ?(margin = 8) println main =
let vtbnames = ref [] in
let vtbqueue = ref [] in
let vtbname vtb = try List.assq vtb !vtbnames
with Not_found ->
let name = Fmt.str "$tb%d" (List.length !vtbnames) in
vtbnames := (vtb, name) :: !vtbnames;
vtbqueue := !vtbqueue @ [vtb];
name
in
let printf ?l fmt = let printf ?l fmt =
let prefix = match l with let prefix = match l with
| None -> "" | None -> ""
@ -261,7 +269,7 @@ let dump ?(margin = 8) println main =
printf ?l:t.label "%a" pp_i0 i printf ?l:t.label "%a" pp_i0 i
| I1 (i, t1) -> | I1 (i, t1) ->
printf ?l:t.label "%a" pp_i1 i; printf ?l:t.label "%a" (pp_i1 ~vtbname) i;
pr_code t1 pr_code t1
| I2 (i, t1, t2) -> | I2 (i, t1, t2) ->
@ -277,13 +285,31 @@ let dump ?(margin = 8) println main =
and maybe_pr_code t = and maybe_pr_code t =
if t.preds > 0 then if t.preds > 0 then
pr_code t pr_code t
in in
let pr_funct name fn = let pr_funct name fn =
println (Fmt.str "# fun %s(%d)" name fn.n_args); println (Fmt.str "# fun %s(%d)" name fn.n_args);
generate_labels fn.entry; generate_labels fn.entry;
pr_code fn.entry pr_code fn.entry;
println ""
in in
pr_funct "main" main let pr_vtable (vtb : Value.vtable) =
let vnam = vtbname vtb in
Hashtbl.iter
(fun fnam -> function
| Value.Method i ->
begin match vtb.mthds.(i) with
| Function fn ->
pr_funct (Fmt.str "%s.%s" vnam fnam) fn
| _ -> ()
end
| _ -> ())
vtb.elems
in
pr_funct "main" main;
while recursive && !vtbqueue <> [] do
pr_vtable (List.hd !vtbqueue);
vtbqueue := List.tl !vtbqueue
done