src/LIN/LINPrinter.ml

   1
   2 (** This module provides a function to print [LIN] programs. *)
   3
   4
   5 let n_spaces n = String.make n ' '
   6
   7
   8 let print_global n (x, size) =
   9   Printf.sprintf "%s\"%s\" [%d]" (n_spaces n) x size
  10
  11 let print_globals eformat n globs =
  12   Eformat.printf eformat "%sglobals:\n" (n_spaces n) ;
  13   List.iter
  14     (fun g -> Eformat.printf eformat "%s\n" (print_global (n+2) g)) globs
  15
  16
  17 let print_reg = I8051.print_register
  18
  19 let print_a = print_reg I8051.a
  20
  21
  22 let print_statement = function
  23   | LIN.St_goto lbl -> "goto " ^ lbl
  24   | LIN.St_label lbl -> lbl ^ ":"
  25   | LIN.St_comment s ->
  26     Printf.sprintf "*** %s ***" s
  27   | LIN.St_cost cost_lbl ->
  28     Printf.sprintf "emit %s" cost_lbl
  29   | LIN.St_int (dstr, i) ->
  30     Printf.sprintf "imm %s, %d" (print_reg dstr) i
  31   | LIN.St_pop ->
  32     Printf.sprintf "pop %s" print_a
  33   | LIN.St_push ->
  34     Printf.sprintf "push %s" print_a
  35   | LIN.St_addr id ->
  36     Printf.sprintf "addr DPTR, %s" id
  37   | LIN.St_from_acc dstr ->
  38     Printf.sprintf "move %s, %s" (print_reg dstr) print_a
  39   | LIN.St_to_acc srcr ->
  40     Printf.sprintf "move %s, %s" print_a (print_reg srcr)
  41   | LIN.St_opaccs opaccs ->
  42     Printf.sprintf "%s %s, %s"
  43       (I8051.print_opaccs opaccs) print_a (print_reg I8051.b)
  44   | LIN.St_op1 op1 ->
  45     Printf.sprintf "%s %s" (I8051.print_op1 op1) print_a
  46   | LIN.St_op2 (op2, srcr) ->
  47     Printf.sprintf "%s %s, %s"
  48       (I8051.print_op2 op2) print_a (print_reg srcr)
  49   | LIN.St_clear_carry -> "clear CARRY"
  50   | LIN.St_set_carry -> "set CARRY"
  51   | LIN.St_load ->
  52     Printf.sprintf "movex %s, @DPTR" print_a
  53   | LIN.St_store ->
  54     Printf.sprintf "movex @DPTR, %s" print_a
  55   | LIN.St_call_id f -> Printf.sprintf "call \"%s\"" f
  56   | LIN.St_call_ptr ->
  57     Printf.sprintf "call_ptr DPTR"
  58   | LIN.St_condacc lbl_true ->
  59     Printf.sprintf "branch %s <> 0, %s" print_a lbl_true
  60   | LIN.St_return -> "return"
  61
  62
  63 let print_code eformat n c =
  64   let f stmt =
  65     Eformat.printf eformat "\n%s%s" (n_spaces n) (print_statement stmt) in
  66   List.iter f c
  67
  68
  69 let print_internal_decl eformat n f def =
  70   Eformat.printf eformat "%s\"%s\"\n\n" (n_spaces n) f ;
  71   print_code eformat (n+2) def
  72
  73
  74 let print_external_decl eformat n f def =
  75   Eformat.printf eformat "%sextern \"%s\": %s\n"
  76     (n_spaces n)
  77     f
  78     (Primitive.print_sig def.AST.ef_sig)
  79
  80
  81 let print_fun_decl eformat n (f, def) = match def with
  82   | LIN.F_int def -> print_internal_decl eformat n f def
  83   | LIN.F_ext def -> print_external_decl eformat n f def
  84
  85 let print_fun_decls eformat n functs =
  86   List.iter
  87     (fun f -> print_fun_decl eformat n f ; Eformat.printf eformat "\n\n") functs
  88
  89
  90 let print_program p =
  91   let eformat = Eformat.create () in
  92   Eformat.printf eformat "program:\n\n\n" ;
  93   print_globals eformat 2 p.LIN.vars ;
  94   Eformat.printf eformat "\n\n" ;
  95   print_fun_decls eformat 2 p.LIN.functs ;
  96   Eformat.get eformat