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 =
+let pp_vtable ~tbname ppf (vtb : vtable) =
-  Fmt.pf ppf "(%d){" vt.Value.n_slots;
+  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;
+         Fmt.pf ppf "%s%s=%d" !sep name idx;
-         sep := ";")
+         sep := ",")
-    vt.elems;
+    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,7 +152,19 @@ 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 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 ->
+      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 dump_fn fn =
     let labels = ref [ fn.entry, "ENTRY" ] in
     let label b =
       try List.assq b !labels
@@ -161,7 +173,7 @@ let dump println fn =
         let l = Fmt.str "B%d" n in
         labels := (b, l) :: !labels; l
     in
-  let pp_ins = pp_ins ~label in
+    let pp_ins = pp_ins ~tbname ~label in
     iter_blocks_df
       (fun b ->
          List.fold_left
@@ -172,3 +184,28 @@ let dump println fn =
            (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 ()
+