add recursive bytecode printout for vtables

lib/runtime/code.ml

@@ -115,19 +115,19 @@ let make_funct n_args entry =
 
 let pp_reg ppf (R i) = Fmt.pf ppf "R%d" i
 
-let pp_vtable ppf vt =
-  Fmt.pf ppf "(%d){" vt.Value.n_slots;
+let pp_vtable ~tbname ppf (vtb : vtable) =
+  Fmt.pf ppf "%s(%d){" (tbname 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 := ";")
-    vt.elems;
+         Fmt.pf ppf "%s%s=%d" !sep name idx;
+         sep := ",")
+    vtb.elems;
   Fmt.pf ppf "}"
 
-let pp_ins ~label ppf = function
+let pp_ins ~tbname ~label ppf = function
   | LDI (a, b) -> Fmt.pf ppf "mov %a, %s" pp_reg a (Value.to_string b)
   | LDR (a, b) -> Fmt.pf ppf "mov %a, %a" pp_reg a pp_reg b 
   | ADD (a, b, c) -> Fmt.pf ppf "add %a, %a, %a" pp_reg a pp_reg b pp_reg c
@@ -140,7 +140,7 @@ let pp_ins ~label ppf = function
   | GET (a, b, c) -> Fmt.pf ppf "mov %a, %a[%a]" pp_reg a pp_reg b pp_reg c
   | SET (a, b, c) -> Fmt.pf ppf "mov %a[%a], %a" pp_reg b pp_reg c pp_reg a
   | LOC (a, b, el) -> Fmt.pf ppf "loc %a, %a.%s" pp_reg a pp_reg b el
-  | CON (a, vt) -> Fmt.pf ppf "con %a, %a" pp_reg a pp_vtable vt
+  | CON (a, vt) -> Fmt.pf ppf "con %a, %a" pp_reg a (pp_vtable ~tbname) vt
   | CAL (a, b, c, ds) ->
     Fmt.pf ppf "cal %a, %a[%a](" pp_reg a pp_reg b pp_reg c;
     List.iteri (fun i d -> if i > 0 then Fmt.pf ppf ","; pp_reg ppf d) ds;
@@ -152,23 +152,60 @@ let pp_ins ~label ppf = function
     let l2 = label b2 in
     Fmt.pf ppf "cbr %a, %s, %s" pp_reg a l1 l2
 
-let dump println fn =
-  let labels = ref [ fn.entry, "ENTRY" ] in
-  let label b =
-    try List.assq b !labels
+let dump ?(recursive = true) println main_fn =
+  let tbqueue = ref [] in
+  let tbnames = ref [] in
+  let tbname vtb =
+    try List.assq vtb !tbnames
     with Not_found ->
-      let n = List.length !labels - 1 in
-      let l = Fmt.str "B%d" n in
-      labels := (b, l) :: !labels; l
+      if recursive then tbqueue := !tbqueue @ [vtb];
+      let n = List.length !tbnames in
+      let l = Fmt.str "$tbl%d" n in
+      tbnames := (vtb, l) :: !tbnames; l
   in
-  let pp_ins = pp_ins ~label in
-  iter_blocks_df
-    (fun b ->
-       List.fold_left
-         (fun pfx ins ->
-            println (Fmt.str "%-8s%a" pfx pp_ins ins);
-            "")
-         (label b ^ ":")
-         (instructions b)
-       |> ignore)
-    fn.entry
+
+  let dump_fn fn =
+    let labels = ref [ fn.entry, "ENTRY" ] in
+    let label b =
+      try List.assq b !labels
+      with Not_found ->
+        let n = List.length !labels - 1 in
+        let l = Fmt.str "B%d" n in
+        labels := (b, l) :: !labels; l
+    in
+    let pp_ins = pp_ins ~tbname ~label in
+    iter_blocks_df
+      (fun b ->
+         List.fold_left
+           (fun pfx ins ->
+              println (Fmt.str "%-8s%a" pfx pp_ins ins);
+              "")
+           (label b ^ ":")
+           (instructions b)
+         |> ignore)
+      fn.entry
+  in
+
+  println "# fun main(0)";
+  dump_fn main_fn;
+
+  let rec loop () =
+    match !tbqueue with
+    | [] -> ()
+    | vtb :: rest ->
+      tbqueue := rest;
+      Hashtbl.iter
+        (fun fname -> function
+           | Value.Field _ -> ()
+           | Value.Method i ->
+             match vtb.mthds.(i) with
+             | Function fn ->
+               println "";
+               println (Fmt.str "# fun %s.%s(%d)" (tbname vtb) fname fn.n_args);
+               dump_fn fn
+             | _ -> ())
+        vtb.elems;
+      loop ()
+  in
+  loop ()
+