source: Deliverables/D2.2/8051/src/RTLabs/RTLabsPrinter.ml @ 640

let n_spaces n = String.make n ' '


let print_global n (x, size) =
  Printf.sprintf "%s\"%s\" [%d]" (n_spaces n) x size

let print_globals n globs =
  Printf.sprintf "%sglobals:\n%s"
    (n_spaces n)
    (List.fold_left (fun s g -> s ^ (print_global (n+2) g) ^ "\n") "" globs)


let print_reg_list rl =
  Printf.sprintf "[%s]" (MiscPottier.string_of_list " ; " Register.print rl)

let rec print_args args =
  Printf.sprintf "[%s]" (MiscPottier.string_of_list ", " print_reg_list args)

let print_result rl = print_reg_list rl

let print_params rl =
  Printf.sprintf "(%s)" (MiscPottier.string_of_list ", " print_reg_list rl)

let print_locals rl =
  Printf.sprintf "%s" (MiscPottier.string_of_list ", " print_reg_list rl)


let print_memory_q = Memory.string_of_memory_q


let print_cmp = function
  | AST.Cmp_eq -> "eq"
  | AST.Cmp_ne -> "ne"
  | AST.Cmp_gt -> "gt"
  | AST.Cmp_ge -> "ge"
  | AST.Cmp_lt -> "lt"
  | AST.Cmp_le -> "le"

let print_cst = function
  | AST.Cst_int i -> Printf.sprintf "imm_int %d" i
  | AST.Cst_float f -> Printf.sprintf "imm_float %f" f
  | AST.Cst_addrsymbol id -> Printf.sprintf "imm_addr \"%s\"" id
  | AST.Cst_stackoffset off -> Printf.sprintf "imm_addr %d(STACK)" off

let print_op1 = function
  | AST.Op_cast8unsigned -> "cast8u"
  | AST.Op_cast8signed -> "cast8"
  | AST.Op_cast16unsigned -> "cast16u"
  | AST.Op_cast16signed -> "cast16"
  | AST.Op_negint -> "negint"
  | AST.Op_notbool -> "notbool"
  | AST.Op_notint -> "notint"
  | AST.Op_negf -> "negf"
  | AST.Op_absf -> "absf"
  | AST.Op_singleoffloat -> "singleoffloat"
  | AST.Op_intoffloat -> "intoffloat"
  | AST.Op_intuoffloat -> "intuoffloat"
  | AST.Op_floatofint -> "floatofint"
  | AST.Op_floatofintu -> "floatofintu"
  | AST.Op_id -> "mov"
  | AST.Op_ptrofint -> "ptrofint"
  | AST.Op_intofptr -> "intofptr"

let print_op2 = function
  | AST.Op_add -> "add"
  | AST.Op_sub -> "sub"
  | AST.Op_mul -> "mul"
  | AST.Op_div -> "div"
  | AST.Op_divu -> "divu"
  | AST.Op_mod -> "mod"
  | AST.Op_modu -> "modu"
  | AST.Op_and -> "and"
  | AST.Op_or -> "or"
  | AST.Op_xor -> "xor"
  | AST.Op_shl -> "shl"
  | AST.Op_shr -> "shr"
  | AST.Op_shru -> "shru"
  | AST.Op_addf -> "addf"
  | AST.Op_subf -> "subf"
  | AST.Op_mulf -> "mulf"
  | AST.Op_divf -> "divf"
  | AST.Op_cmp cmp -> print_cmp cmp
  | AST.Op_cmpu cmp -> (print_cmp cmp) ^ "u"
  | AST.Op_cmpf cmp -> (print_cmp cmp) ^ "f"
  | AST.Op_addp -> "addp"
  | AST.Op_subp -> "subp"
  | AST.Op_cmpp cmp -> (print_cmp cmp) ^ "p"


let print_addressing = function
  | RTLabs.Aindexed off -> Printf.sprintf "%d" off
  | RTLabs.Aindexed2 -> "add"
  | RTLabs.Aglobal (id, off) -> Printf.sprintf "%d(\"%s\")" off id
  | RTLabs.Abased (id, off) -> Printf.sprintf "add, %d(\"%s\")" off id
  | RTLabs.Ainstack off -> Printf.sprintf "%d(STACK)" off


let rec print_table = function
  | [] -> ""
  | [lbl] -> lbl
  | lbl :: tbl -> lbl ^ ", " ^ (print_table tbl)


let print_statement = function
  | RTLabs.St_skip lbl -> "--> " ^ lbl
  | RTLabs.St_cost (cost_lbl, lbl) ->
      Printf.sprintf "emit %s --> %s" cost_lbl lbl
  | RTLabs.St_cst (dests, cst, lbl) ->
      Printf.sprintf "imm %s, %s --> %s"
        (print_reg_list dests)
        (print_cst cst)
        lbl
  | RTLabs.St_op1 (op1, dests, srcs, lbl) ->
      Printf.sprintf "%s %s, %s --> %s"
        (print_op1 op1)
        (print_reg_list dests)
        (print_reg_list srcs)
        lbl
  | RTLabs.St_op2 (op2, dests, srcs1, srcs2, lbl) ->
      Printf.sprintf "%s %s, %s, %s --> %s"
        (print_op2 op2)
        (print_reg_list dests)
        (print_reg_list srcs1)
        (print_reg_list srcs2)
        lbl
  | RTLabs.St_load (chunk, mode, args, dests, lbl) ->
      Printf.sprintf "load %s, %s, %s, %s --> %s"
        (print_memory_q chunk)
        (print_addressing mode)
        (print_args args)
        (print_reg_list dests)
        lbl
  | RTLabs.St_store (chunk, mode, args, srcs, lbl) ->
      Printf.sprintf "store %s, %s, %s, %s --> %s"
        (print_memory_q chunk)
        (print_addressing mode)
        (print_args args)
        (print_reg_list srcs)
        lbl
  | RTLabs.St_call_id (f, args, res, sg, lbl) ->
      Printf.sprintf "call \"%s\", %s, %s: %s --> %s"
        f
        (print_params args)
        (print_reg_list res)
        (Primitive.print_sig sg)
        lbl
  | RTLabs.St_call_ptr (f, args, res, sg, lbl) ->
      Printf.sprintf "call_ptr %s, %s, %s: %s --> %s"
        (print_reg_list f)
        (print_params args)
        (print_reg_list res)
        (Primitive.print_sig sg)
        lbl
  | RTLabs.St_tailcall_id (f, args, sg) ->
      Printf.sprintf "tailcall \"%s\", %s: %s"
        f
        (print_params args)
        (Primitive.print_sig sg)
  | RTLabs.St_tailcall_ptr (f, args, sg) ->
      Printf.sprintf "tailcall_ptr \"%s\", %s: %s"
        (print_reg_list f)
        (print_params args)
        (Primitive.print_sig sg)
  | RTLabs.St_condcst (cst, lbl_true, lbl_false) ->
      Printf.sprintf "%s --> %s, %s"
        (print_cst cst)
        lbl_true
        lbl_false
  | RTLabs.St_cond1 (op1, srcs, lbl_true, lbl_false) ->
      Printf.sprintf "%s %s --> %s, %s"
        (print_op1 op1)
        (print_reg_list srcs)
        lbl_true
        lbl_false
  | RTLabs.St_cond2 (op2, srcs1, srcs2, lbl_true, lbl_false) ->
      Printf.sprintf "%s %s, %s --> %s, %s"
        (print_op2 op2)
        (print_reg_list srcs1)
        (print_reg_list srcs2)
        lbl_true
        lbl_false
  | RTLabs.St_jumptable (rs, tbl) ->
      Printf.sprintf "j_tbl %s --> %s"
        (print_reg_list rs)
        (print_table tbl)
  | RTLabs.St_return rs -> Printf.sprintf "return %s" (print_reg_list rs)


let print_graph n c =
  let f lbl stmt s =
    Printf.sprintf "%s%s: %s\n%s"
      (n_spaces n)
      lbl
      (print_statement stmt)
      s in
  Label.Map.fold f c ""


let print_internal_decl n f def =

  Printf.sprintf
    "%s\"%s\"%s: %s\n%slocals: %s\n%sresult: %s\n%sstacksize: %d\n%sentry: %s\n%sexit: %s\n\n%s"
    (n_spaces n)
    f
    (print_params def.RTLabs.f_params)
    (Primitive.print_sig def.RTLabs.f_sig)
    (n_spaces (n+2))
    (print_locals def.RTLabs.f_locals)
    (n_spaces (n+2))
    (print_result def.RTLabs.f_result)
    (n_spaces (n+2))
    def.RTLabs.f_stacksize
    (n_spaces (n+2))
    def.RTLabs.f_entry
    (n_spaces (n+2))
    def.RTLabs.f_exit
    (print_graph (n+2) def.RTLabs.f_graph)


let print_external_decl n f def =
  Printf.sprintf "%sextern \"%s\": %s\n"
    (n_spaces n)
    f
    (Primitive.print_sig def.AST.ef_sig)


let print_fun_decl n (f, def) = match def with
  | RTLabs.F_int def -> print_internal_decl n f def
  | RTLabs.F_ext def -> print_external_decl n f def

let print_fun_decls n functs =
  List.fold_left (fun s f -> s ^ (print_fun_decl n f) ^ "\n\n") ""
    functs


let print_program p =
  Printf.sprintf "program:\n\n\n%s\n\n%s"
    (print_globals 2 p.RTLabs.vars)
    (print_fun_decls 2 p.RTLabs.functs)