forked from esumii/min-caml
-
Notifications
You must be signed in to change notification settings - Fork 0
/
asm.ml
91 lines (84 loc) · 3.74 KB
/
asm.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
(* 2オペランドではなく3オペランドのx86アセンブリもどき *)
type id_or_imm = V of Id.t | C of int
type t = (* 命令の列 (caml2html: sparcasm_t) *)
| Ans of exp
| Let of (Id.t * Type.t) * exp * t
and exp = (* 一つ一つの命令に対応する式 (caml2html: sparcasm_exp) *)
| Nop
| Set of int
| SetL of Id.l
| Mov of Id.t
| Neg of Id.t
| Add of Id.t * id_or_imm
| Sub of Id.t * id_or_imm
| Ld of Id.t * id_or_imm * int
| St of Id.t * Id.t * id_or_imm * int
| FMovD of Id.t
| FNegD of Id.t
| FAddD of Id.t * Id.t
| FSubD of Id.t * Id.t
| FMulD of Id.t * Id.t
| FDivD of Id.t * Id.t
| LdDF of Id.t * id_or_imm * int
| StDF of Id.t * Id.t * id_or_imm * int
| Comment of string
(* virtual instructions *)
| IfEq of Id.t * id_or_imm * t * t
| IfLE of Id.t * id_or_imm * t * t
| IfGE of Id.t * id_or_imm * t * t (* 左右対称ではないので必要 *)
| IfFEq of Id.t * Id.t * t * t
| IfFLE of Id.t * Id.t * t * t
(* closure address, integer arguments, and float arguments *)
| CallCls of Id.t * Id.t list * Id.t list
| CallDir of Id.l * Id.t list * Id.t list
| Save of Id.t * Id.t (* レジスタ変数の値をスタック変数へ保存 (caml2html: sparcasm_save) *)
| Restore of Id.t (* スタック変数から値を復元 (caml2html: sparcasm_restore) *)
type fundef = { name : Id.l; args : Id.t list; fargs : Id.t list; body : t; ret : Type.t }
(* プログラム全体 = 浮動小数点数テーブル + トップレベル関数 + メインの式 (caml2html: sparcasm_prog) *)
type prog = Prog of (Id.l * float) list * fundef list * t
let fletd(x, e1, e2) = Let((x, Type.Float), e1, e2)
let seq(e1, e2) = Let((Id.gentmp Type.Unit, Type.Unit), e1, e2)
let regs = (* Array.init 16 (fun i -> Printf.sprintf "%%r%d" i) *)
[| "%eax"; "%ebx"; "%ecx"; "%edx"; "%esi"; "%edi" |]
let fregs = Array.init 8 (fun i -> Printf.sprintf "%%xmm%d" i)
let allregs = Array.to_list regs
let allfregs = Array.to_list fregs
let reg_cl = regs.(Array.length regs - 1) (* closure address (caml2html: sparcasm_regcl) *)
(*
let reg_sw = regs.(Array.length regs - 1) (* temporary for swap *)
let reg_fsw = fregs.(Array.length fregs - 1) (* temporary for swap *)
*)
let reg_sp = "%ebp" (* stack pointer *)
let reg_hp = "min_caml_hp" (* heap pointer (caml2html: sparcasm_reghp) *)
let reg_hend = "min_caml_hend"
let reg_stop = "min_caml_stop"
let reg_stack_tmp = "stack_tmp"
(* let reg_ra = "%eax" (* return address *) *)
let is_reg x = (x.[0] = '%' || x = reg_hp)
(* super-tenuki *)
let rec remove_and_uniq xs = function
| [] -> []
| x :: ys when S.mem x xs -> remove_and_uniq xs ys
| x :: ys -> x :: remove_and_uniq (S.add x xs) ys
(* free variables in the order of use (for spilling) (caml2html: sparcasm_fv) *)
let fv_id_or_imm = function V(x) -> [x] | _ -> []
let rec fv_exp = function
| Nop | Set(_) | SetL(_) | Comment(_) | Restore(_) -> []
| Mov(x) | Neg(x) | FMovD(x) | FNegD(x) | Save(x, _) -> [x]
| Add(x, y') | Sub(x, y') | Ld(x, y', _) | LdDF(x, y', _) -> x :: fv_id_or_imm y'
| St(x, y, z', _) | StDF(x, y, z', _) -> x :: y :: fv_id_or_imm z'
| FAddD(x, y) | FSubD(x, y) | FMulD(x, y) | FDivD(x, y) -> [x; y]
| IfEq(x, y', e1, e2) | IfLE(x, y', e1, e2) | IfGE(x, y', e1, e2) -> x :: fv_id_or_imm y' @ remove_and_uniq S.empty (fv e1 @ fv e2) (* uniq here just for efficiency *)
| IfFEq(x, y, e1, e2) | IfFLE(x, y, e1, e2) -> x :: y :: remove_and_uniq S.empty (fv e1 @ fv e2) (* uniq here just for efficiency *)
| CallCls(x, ys, zs) -> x :: ys @ zs
| CallDir(_, ys, zs) -> ys @ zs
and fv = function
| Ans(exp) -> fv_exp exp
| Let((x, t), exp, e) ->
fv_exp exp @ remove_and_uniq (S.singleton x) (fv e)
let fv e = remove_and_uniq S.empty (fv e)
let rec concat e1 xt e2 =
match e1 with
| Ans(exp) -> Let(xt, exp, e2)
| Let(yt, exp, e1') -> Let(yt, exp, concat e1' xt e2)
let align i = (if i mod 8 = 0 then i else i + 4)