diff --git a/lib/runtime/code.ml b/lib/runtime/code.ml index 5548d30..c791448 100644 --- a/lib/runtime/code.ml +++ b/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 () +