クロージャを使ったプログラムのAArch64コードを出力

エラー対応

以下のコマンドを実行して、出てきたビルドエラーに対応中

code:sh

make clean && ./to_aarch64 && make min-caml && ./min-caml test/adder && gcc test/adder.s samples/stub.c -o test/a.out && ./test/a.out

ビルドエラーが出なくなったけど、実行時エラーがががが

https://gyazo.com/421e76f43a6926d4ab19c23f3b91cb81

https://gyazo.com/32f153e1190476a23bd5a2a832de2c2b

code:ml

let ic = open_in "test/adder.ml" in let b = Buffer.create 0 in (Buffer.add_channel b ic (in_channel_length ic); Buffer.contents b);;

中間コードを眺めてみる

adder.ml

code:ml

let rec make_adder x =

let rec adder y = x + y in

adder in

print_int ((make_adder 3) 7)

ASM形式

code:ml

- : Asm.prog =

Asm.Prog ([],

body =

Asm.Let (("%x1", Type.Int), Asm.Lwz ("%x25", Asm.C 4),

Asm.Ans (Asm.Add ("%x1", Asm.V "%x0")));

ret = Type.Int};

body =

Asm.Let (("%x27", Type.Int), Asm.Add ("%x27", Asm.C 8),

Asm.Let (("%x2", Type.Int), Asm.SetL (Id.L "adder.11"),

Asm.Let (("%x0", Type.Unit), Asm.Stw ("%x2", "%x1", Asm.C 0),

Asm.Let (("%x0", Type.Unit), Asm.Stw ("%x0", "%x1", Asm.C 4),

Asm.Ans (Asm.Mr "%x1"))))));

Asm.Let (("%x0", Type.Int), Asm.Li 3,

Asm.Let (("%x0", Type.Int), Asm.Li 7,

K正規形

code:ml

- : KNormal.t =

KNormal.LetRec

({KNormal.name =

body =

KNormal.LetRec

KNormal.Var "adder")},

KNormal.Let (("Ti20", Type.Int),

KNormal.Let (("Ti17", Type.Int), KNormal.Int 3,

KNormal.Let (("Ti19", Type.Int), KNormal.Int 7,

中間形式の出力

ASM形式を出力

code:ml

let f = "test/adder.ml" in

let ic = open_in f in

let b = Buffer.create 0 in

let src = (Buffer.add_channel b ic (in_channel_length ic); Buffer.contents b) in

(RegAlloc.f (Simm.f (Virtual.f (Closure.f (Alpha.f (KNormal.f (Typing.f (Parser.exp Lexer.token (Lexing.from_string src)))))))));;

K正規形を出力

code:ml

(* K *)

let f = "test/adder.ml" in

let ic = open_in f in

let b = Buffer.create 0 in

let src = (Buffer.add_channel b ic (in_channel_length ic); Buffer.contents b) in

(KNormal.f (Typing.f (Parser.exp Lexer.token (Lexing.from_string src))));;

make_adderの動き

前提知識

x28がSP（スタックポインタ）x27がhp（ヒープポインタレジスタ）x26がtmpレジスタ

x25がクロージャアドレス

x24がswap用tmpレジスタ

動き

下記のコード中のコメントを参照

メモ

現在のPCの値

pc unsigned long 0x0000000100003d48

全然違う...

code:make_adder

adder.11: # クロージャで実行される関数

add x0, x1, x0

ret

make_adder.5:

mov x1, x27 # ヒープポインタの値をx1に代入

add x27, x27, 16 # ヒープポインタを16進める

ldr x2, adder.11 # x2 に adder.11 のアドレスを代入したい...

mov x0, x1 # クロージャの先頭アドレスを x0 に代入

ret # クロージャの先頭アドレスを返す

最終的なdiff

adder.ml が動いた！

変更箇所は以下のとおり。

code:diff

diff --git a/AArch64/asm.ml b/AArch64/asm.ml

index 7530076..9556bdf 100644

--- a/AArch64/asm.ml

+++ b/AArch64/asm.ml

@@ -48,7 +48,7 @@ let seq(e1, e2) = Let((Id.gentmp Type.Unit, Type.Unit), e1, e2)

let regs = (* Array.init 27 (fun i -> Printf.sprintf "_R_%d" i) *)

[| "%x0"; "%x1"; "%x2"; "%x3"; "%x4"; "%x5"; "%x6"; "%x7"; "%x8"; "%x9"; "%x10";

"%x11"; "%x12"; "%x13"; "%x14"; "%x15"; "%x16"; "%x17"; "%x18"; "%x19"; "%x20";

- "%x21"; "%x22"; "%x23"; "%x24"; "%x25"; "%x26"; "%x27"; "%x28" |]

+ "%x21"; "%x22"; "%x23"; "%x24"; "%x25" |]

let fregs = Array.init 32 (fun i -> Printf.sprintf "%%f%d" i)

let allregs = Array.to_list regs

let allfregs = Array.to_list fregs

diff --git a/AArch64/emit.ml b/AArch64/emit.ml

index f9581e0..e24db4f 100644

--- a/AArch64/emit.ml

+++ b/AArch64/emit.ml

@@ -33,9 +33,7 @@ let reg r =

let load_label r label =

let r' = reg r in

- Printf.sprintf

- "\tlis\t%s, ha16(%s)\n\taddi\t%s, %s, lo16(%s)\n"

- r' label r' r' label

+ Printf.sprintf "\tadr %s, %s\n" r' label

(* 関数呼び出しのために引数を並べ替える(register shuffling) (caml2html: emit_shuffle) *)

let rec shuffle sw xys =

@@ -77,7 +75,7 @@ and g' oc = function (* 各命令のアセンブリ生成 (caml2html: emit_gprim

let s = load_label x y in

Printf.fprintf oc "%s" s

| NonTail(x), Mr(y) when x = y -> ()

- | NonTail(x), Mr(y) -> Printf.fprintf oc "\tmr\t%s, %s\n" (reg x) (reg y)

+ | NonTail(x), Mr(y) -> Printf.fprintf oc "\tmov %s, %s\n" (reg x) (reg y)

| NonTail(x), Neg(y) -> Printf.fprintf oc "\tneg\t%s, %s\n" (reg x) (reg y)

| NonTail(x), Add(y, V(z)) -> Printf.fprintf oc "\tadd\t%s, %s, %s\n" (reg x) (reg y) (reg z)

| NonTail(x), Add(y, C(z)) -> Printf.fprintf oc "\tadd\t%s, %s, %d\n" (reg x) (reg y) z

@@ -86,9 +84,9 @@ and g' oc = function (* 各命令のアセンブリ生成 (caml2html: emit_gprim

| NonTail(x), Slw(y, V(z)) -> Printf.fprintf oc "\tslw\t%s, %s, %s\n" (reg x) (reg y) (reg z)

| NonTail(x), Slw(y, C(z)) -> Printf.fprintf oc "\tslwi\t%s, %s, %d\n" (reg x) (reg y) z

| NonTail(x), Lwz(y, V(z)) -> Printf.fprintf oc "\tlwzx\t%s, %s, %s\n" (reg x) (reg y) (reg z)

- | NonTail(x), Lwz(y, C(z)) -> Printf.fprintf oc "\tlwz\t%s, %d(%s)\n" (reg x) z (reg y)

| NonTail(_), Stw(x, y, V(z)) -> Printf.fprintf oc "\tstwx\t%s, %s, %s\n" (reg x) (reg y) (reg z)

- | NonTail(_), Stw(x, y, C(z)) -> Printf.fprintf oc "\tstw\t%s, %d(%s)\n" (reg x) z (reg y)

| NonTail(x), FMr(y) when x = y -> ()

| NonTail(x), FMr(y) -> Printf.fprintf oc "\tfmr\t%s, %s\n" (reg x) (reg y)

| NonTail(x), FNeg(y) -> Printf.fprintf oc "\tfneg\t%s, %s\n" (reg x) (reg y)

@@ -188,21 +186,40 @@ and g' oc = function (* 各命令のアセンブリ生成 (caml2html: emit_gprim

g'_args oc [] ys zs;

Printf.fprintf oc "\tb\t%s\n" x

| NonTail(a), CallCls(x, ys, zs) ->

- Printf.fprintf oc "\tmflr\t%s\n" (reg reg_tmp);

+ Printf.fprintf oc "\t# CallCls start: %s\n" x;

+

+ (* Printf.fprintf oc "\tmflr\t%s\n" (reg reg_tmp); *)

let ss = stacksize () in

- Printf.fprintf oc "\tstw\t%s, %d(%s)\n" (reg reg_tmp) (ss - 4) (reg reg_sp);

- Printf.fprintf oc "\taddi\t%s, %s, %d\n" (reg reg_sp) (reg reg_sp) ss;

- Printf.fprintf oc "\tlwz\t%s, 0(%s)\n" (reg reg_tmp) (reg reg_cl);

- Printf.fprintf oc "\tmtctr\t%s\n" (reg reg_tmp);

- Printf.fprintf oc "\tbctrl\n";

- Printf.fprintf oc "\tsubi\t%s, %s, gs%d\n" (reg reg_sp) (reg reg_sp) ss;

- Printf.fprintf oc "\tlwz\t%s, %d(%s)\n" (reg reg_tmp) (ss - 4) (reg reg_sp);

+

+ (* lrをスタックへ退避 *)

+ Printf.fprintf oc "\tmov %s, lr\n" (reg reg_tmp);

+ Printf.fprintf oc "\tadd %s, %s, %d\n" (reg reg_sp) (reg reg_sp) ss;

+ (* Printf.fprintf oc "\tstw\t%s, %d(%s)\n" (reg reg_tmp) (ss - 4) (reg reg_sp);

+ Printf.fprintf oc "\taddi\t%s, %s, %d\n" (reg reg_sp) (reg reg_sp) ss; *)

+

+ (* 読み込んだクロージャのアドレスへ飛んでいる？ *)

+ Printf.fprintf oc "\tblr %s\n" (reg reg_tmp);

+ (* Printf.fprintf oc "\tmtctr\t%s\n" (reg reg_tmp); *)

+ (* Printf.fprintf oc "\tbctrl\n"; *)

+

+ (* Printf.fprintf oc "\tsubi\t%s, %s, gs%d\n" (reg reg_sp) (reg reg_sp) ss;

+ Printf.fprintf oc "\tlwz\t%s, %d(%s)\n" (reg reg_tmp) (ss - 4) (reg reg_sp); *)

+ Printf.fprintf oc "\tsub %s, %s, %d\n" (reg reg_sp) (reg reg_sp) ss;

+

if List.mem a allregs && a <> regs.(0) then

- Printf.fprintf oc "\tmr\t%s, %s\n" (reg a) (reg regs.(0))

+ Printf.fprintf oc "\tmov %s, %s\n" (reg a) (reg regs.(0))

else if List.mem a allfregs && a <> fregs.(0) then

Printf.fprintf oc "\tfmr\t%s, %s\n" (reg a) (reg fregs.(0));

- Printf.fprintf oc "\tmtlr\t%s\n" (reg reg_tmp)

+

+ (* lrをスタックから復元 *)

+ Printf.fprintf oc "\tmov lr, %s\n" (reg reg_tmp);

+

+ Printf.fprintf oc "\t# CallCls end: %s\n" x

| (NonTail(a), CallDir(Id.L(x), ys, zs)) ->

g'_args oc [] ys zs;

let ss = stacksize () in

diff --git a/AArch64/virtual.ml b/AArch64/virtual.ml

index 3752289..4cf94c9 100644

--- a/AArch64/virtual.ml

+++ b/AArch64/virtual.ml

@@ -29,7 +29,9 @@ let expand xts ini addf addi =

let offset = align offset in

(offset + 8, addf x offset acc))

(fun (offset, acc) x t ->

- (offset + 4, addi x t offset acc))

+ (* NOTE: 64ビットなので4バイトから8バイトにする *)

+ (offset + 8, addi x t offset acc))

+

let rec g env = function (* 式の仮想マシンコード生成 (caml2html: virtual_g) *)

| Closure.Unit -> Ans(Nop)

@@ -78,7 +80,8 @@ let rec g env = function (* 式の仮想マシンコード生成 (caml2html: vir

let offset, store_fv =

expand

(List.map (fun y -> (y, M.find y env)) ys)

- (4, e2')

+ (* NOTE: 64ビットなので4バイトから8バイトにする *)

+ (8, e2')

(fun y offset store_fv -> seq(Stfd(y, x, C(offset)), store_fv))

(fun y _ offset store_fv -> seq(Stw(y, x, C(offset)), store_fv)) in

Let((x, t), Mr(reg_hp),

@@ -147,7 +150,8 @@ let h { Closure.name = (Id.L(x), t); Closure.args = yts; Closure.formal_fv = zts

let (offset, load) =

expand

zts

- (4, g (M.add x t (M.add_list yts (M.add_list zts M.empty))) e)

+ (* NOTE: 64ビットなので4バイトから8バイトにする *)

+ (8, g (M.add x t (M.add_list yts (M.add_list zts M.empty))) e)

(fun z offset load -> fletd(z, Lfd(x, C(offset)), load))

(fun z t offset load -> Let((z, t), Lwz(x, C(offset)), load)) in

match t with