let generate_code prog =
let ret = ref "" in
let next_label = ref 0 in
let get_fresh_label () =
incr next_label;
"L" ^ (string_of_int !next_label)
in
let code_of_proc p =
let string_of_register (Reg_int n) =
if n<0 || n>31 then raise (Asm_error "trying to use a not supported register !")
else (
if n<8 then "%g" ^ (string_of_int n)
else if n<16 then "%o" ^ (string_of_int (n-8))
else if n<24 then "%l" ^ (string_of_int (n-16))
else "%i" ^ (string_of_int (n-24))
)
in
let string_of_flag f =
match f.flag_flag with
| Aflag -> if f.flag_eq then "cc" else "gu"
| Bflag -> if f.flag_eq then "leu" else "cs"
| Cflag -> if f.flag_not then "cc" else "cs"
| Eflag -> if f.flag_not then "ne" else "e"
| Gflag -> if f.flag_eq then "ge" else "g"
| Lflag -> if f.flag_eq then "l" else "le"
| Oflag -> if f.flag_not then "vc" else "vs"
| Sflag -> if f.flag_not then "neg" else "pos"
| Zflag
| Pflag
| Vflag _ -> raise (Asm_error "internal error in string_of_flag")
in
let jump_of_flag f = "b" ^ (string_of_flag f) in
let get_display lex_depth r =
Instr_sparc.store (string_of_register r) ("(DISPLAY" ^ (if lex_depth = 0 then "" else "+" ^ string_of_int (4 * lex_depth)) ^ ")")
in
let code_of_instr instr =
let before = ref "" in
let do_before s =
before := !before ^ s
in
let rec string_of_stack_pos base pos =
let rec get_reg_n = function
| Pos_base n -> string_of_register base, n
| Pos_stack n -> "%sp", n
| Pos_pointed v -> code_of_var v, 0
| Pos_rec _
| Pos_arr _
| Pos_label _
| Pos_none -> raise (Asm_error "internal error in get_reg_n")
in
match pos with
| Pos_label n -> "$" ^ n
| Pos_rec(r, k) ->
(string_of_register (get_var_reg r)) ^
(if k=0 then "" else ((if k>0 then "+" else "" ) ^ (string_of_int k)))
| Pos_arr(a, v, n0, s) ->
(
let ar = string_of_register (get_var_reg a) in
match v.var_def.vd_value with
| Some (Int i) ->
let k = (i - n0) * s in
ar ^ (if k=0 then "" else ((if k>0 then "+" else "") ^ (string_of_int k)))
| _ ->
let vr = get_var_reg v in
do_before (""); ""
)
| Pos_none -> raise (Asm_error "trying to get the position of variable which is not on the stack")
| Pos_base _
| Pos_stack _
| Pos_pointed _ ->
let r,n = get_reg_n pos in
r ^ (if n = 0 then "" else ((if n > 0 then "+" else "") ^ string_of_int n))
and code_of_var_no_reg v =
match v.var_def.vd_value with
| Some(Int i) -> "$" ^ (string_of_int i)
| Some(Bool false) -> "$0"
| Some(Bool true) -> "$1"
| _ -> string_of_stack_pos fp (get_var_pos v)
and code_of_var_reg v =
match v.var_reg with
| Some r -> string_of_register r
| None -> code_of_var_no_reg v
and code_of_var v =
if is_constant v then
code_of_var_no_reg v
else
code_of_var_reg v
in
!before ^
match instr with
| Add_i(v1, v2, v3) ->
let r1 = code_of_var v1 in
let r2 = code_of_var v2 in
let r3 = code_of_var v3 in
Instr_sparc.add r2 r3 r1
| Sub_i(v1, v2, v3) ->
let r1 = code_of_var v1 in
let r2 = code_of_var v2 in
let r3 = code_of_var v3 in
Instr_sparc.sub r2 r3 r1
| Mult_i(v1, v2, v3) ->
let r1 = code_of_var v1 in
let r2 = code_of_var v2 in
let r3 = code_of_var v3 in
Instr_sparc.mult r2 r3 r1
| Mod_i(v1, v2, v3) ->
let r1 = code_of_var v1 in
let r2 = code_of_var v2 in
let r3 = code_of_var v3 in
Instr_sparc.wry "%g0" "%g0" ^
Instr_sparc.nop ^ Instr_sparc.nop ^ Instr_sparc.nop ^
Instr_sparc.div r2 r3 "%g0" ^
Instr_sparc.rdy r1
| Cmp_i(v1, v2, _, v3) ->
let r2 = code_of_var v2 in
let r3 = code_of_var v3 in
Instr_sparc.subcc r2 r3 "%g0"
| Mov_i(v1, v2) ->
let r1 = code_of_var v1 in
let r2 = code_of_var v2 in
Instr_sparc.move r2 r1
| Unspill(lex_scope, v) ->
if not (get_var_ots v) then ""
else
(
let r' = code_of_var v in
if lex_scope then
match get_var_pos v with
| Pos_base b ->
(
match v.var_reg with
| None -> raise (Asm_error "trying to access a variable in an other lexical scope without being assigned to a register")
| Some r ->
get_display (get_var_lex v) r ^
Instr_sparc.load
("[" ^ (string_of_register r) ^ "+"
^ (string_of_int b) ^ "]"
)
r'
)
| _ -> raise (Asm_error "trying to unspill a variable not on the stack and not in the same lexical scope")
else
(
let old_reg = v.var_reg in
v.var_reg <- None;
let r = code_of_var v in
v.var_reg <- old_reg;
Instr_sparc.store r' r
)
)
| Call n -> Instr_sparc.call n
| Nop -> Instr_sparc.nop
| Push v -> let r = code_of_var v
in Instr_sparc.push r
| Code c -> c
in
let rec get_stack_size pv =
List.fold_left (fun size v ->
if get_vd_ots v then
(
v.vd_pos := Pos_base (-size - sizeof (get_vd_type v));
size + sizeof (get_vd_type v)
)
else
size
) 0 pv
in
allocate_registers p.proc_value p.proc_lex_depth;
ret := !ret ^
".globl " ^ p.proc_name ^ "\n" ^
"\t.type\t" ^ p.proc_name ^ ", @function\n" ^ p.proc_name ^ ":\n" ^
(Instr_sparc.save "%sp" (string_of_int (get_stack_size p.proc_vars)) "%sp");
ret := !ret ^ List.fold_left (fun s i -> s ^ code_of_instr i) "" p.proc_value.bb_block ^
"\tret\n\trestore\n"
in
List.iter (fun p -> code_of_proc p) prog.prog_procs; !ret ^ "\t.size\tmain, .-main\n" ^
"\t.section\t.note.GNU-stack,\"\",@progbits\n" ^ "\t.ident\t\"Bifton 0.1.0\"\n"