MinCamlのバグ修正 ( test/funcomp )
test/funcomp のエラーを直したい。
→ 末尾の CallCls を blr じゃなくて br を呼び出すように修正したら動いたよ（一緒に不要なスタックの退避も削除したりした）
code:test/funcomp.ml
let rec compose f g =
let rec composed x = g (f x) in
composed in
let rec dbl x = x + x in
let rec inc x = x + 1 in
let rec dec x = x - 1 in
let h = compose inc (compose dbl dec) in
print_int (h 123)
(* (dec (dbl (inc 123))) => 247 *)
中間表現を確認してみる
code:ml
let rec compose f g =
let rec composed x = g (f x) in
composed in
let rec dbl x = x + x in
let rec dec x = x - 1 in
let h = compose dbl dec in
print_int (h 123)
(* (dbl (dec 123)) => 245 *)
code:ml
- : Asm.prog =
Asm.Prog ([],
[{Asm.name = Id.L "composed.16"; args = "%x0"; fargs = []; body =
Asm.Let (("%x1", Type.Fun (Type.Int, Type.Int)), Asm.Lwz ("%x25", Asm.C 16),
Asm.Let (("%x25", Type.Fun (Type.Int, Type.Int)), Asm.Lwz ("%x25", Asm.C 8),
Asm.Let (("Tu27", Type.Unit), Asm.Save ("%x1", "g.7"),
Asm.Let (("%x0", Type.Int), Asm.CallCls ("%x25", "%x0", []), Asm.Let (("%x25", Type.Int), Asm.Restore "g.7",
Asm.Ans (Asm.CallCls ("%x25", "%x0", []))))))); ret = Type.Int};
{Asm.name = Id.L "compose.5"; args = "%x0"; "%x1"; fargs = []; body =
Asm.Let (("%x2", Type.Fun (Type.Int, Type.Int)), Asm.Mr "%x27", Asm.Let (("%x27", Type.Int), Asm.Add ("%x27", Asm.C 24),
Asm.Let (("%x3", Type.Int), Asm.SetL (Id.L "composed.16"),
Asm.Let (("%x0", Type.Unit), Asm.Stw ("%x3", "%x2", Asm.C 0),
Asm.Let (("%x0", Type.Unit), Asm.Stw ("%x1", "%x2", Asm.C 16),
Asm.Let (("%x0", Type.Unit), Asm.Stw ("%x0", "%x2", Asm.C 8),
Asm.Ans (Asm.Mr "%x2")))))));
{Asm.name = Id.L "dbl.8"; args = "%x0"; fargs = []; body = Asm.Ans (Asm.Add ("%x0", Asm.V "%x0")); ret = Type.Int};
{Asm.name = Id.L "dec.10"; args = "%x0"; fargs = []; body =
Asm.Let (("%x1", Type.Int), Asm.Li 1,
Asm.Ans (Asm.Sub ("%x0", Asm.V "%x1")));
ret = Type.Int}],
Asm.Let (("%x0", Type.Fun (Type.Int, Type.Int)), Asm.Mr "%x27", Asm.Let (("%x27", Type.Int), Asm.Add ("%x27", Asm.C 8),
Asm.Let (("%x1", Type.Int), Asm.SetL (Id.L "dbl.8"),
Asm.Let (("%x0", Type.Unit), Asm.Stw ("%x1", "%x0", Asm.C 0),
Asm.Let (("%x1", Type.Fun (Type.Int, Type.Int)), Asm.Mr "%x27", Asm.Let (("%x27", Type.Int), Asm.Add ("%x27", Asm.C 8),
Asm.Let (("%x2", Type.Int), Asm.SetL (Id.L "dec.10"),
Asm.Let (("%x0", Type.Unit), Asm.Stw ("%x2", "%x1", Asm.C 0),
Asm.Let (("%x25", Type.Fun (Type.Int, Type.Int)), Asm.Let (("%x0", Type.Int), Asm.Li 123, ...)))))))))))
code:asm
.text
.globl _min_caml_start
.align 2
composed.16:
ldr x25, x25, 8 # x25 = dbl のアドレス str x1, x28, 0 # dec をスタックへプッシュ # CallCls start: %x25 #
mov x26, lr # lr をスタックへ退避
add x28, x28, 16 # スタックを広げる
blr x26
sub x28, x28, 16
mov lr, x26
# CallCls end: %x25
# CallCls start: %x25
mov x26, lr
add x28, x28, 16
blr x24
sub x28, x28, 16
mov lr, x26
# CallCls end: %x25
compose.5:
mov x2, x27 # x2 = ヒープの先頭アドレスを保存
add x27, x27, 24 # クロージャのための領域を確保（f, g, composed の3ワード）
adr x3, composed.16 # x3 = composed のアドレス
str x3, x2, 0 # クロージャのために確保した領域へ composed のアドレスを保存 str x1, x2, 16 # クロージャのために確保した領域へ dec のアドレスを保存 str x0, x2, 8 # クロージャのために確保した領域へ dbl のアドレスを保存 mov x0, x2 # クロージャの先頭アドレスを返す
ret
dbl.8:
add x0, x0, x0
ret
dec.10:
sub x0, x0, 1
ret
_min_caml_start: # main entry point
add x28, x0, 0
add x27, x1, 0
add x28, x28, 16
# main program starts
mov x0, x27 # x0 = ヒープ領域の先頭アドレスを保存
add x27, x27, 8 # ヒープを確保して先頭アドレスを更新
adr x1, dbl.8 # x1 = dbl のアドレス
str x1, x0, 0 # ヒープ = x0 へ dbl のアドレスを保存 mov x1, x27 # x1 = ヒープ領域の先頭アドレスを保存
add x27, x27, 8 # ヒープを確保して先頭アドレスを更新
adr x2, dec.10 # x2 = dec のアドレス
str x2, x1, 0 # ヒープ = x1 へ dec のアドレスを保存 mov x26, lr # x26(tmp) へ lr を保存
str x26, x28, 0 # _min_caml_start からの戻り先をスタックへ保存 add x28, x28, 8 # スタックポインタを更新
bl compose.5 # compose を呼び出す
sub x28, x28, 8 # main からの戻り先を x26 へ戻す
mov x25, x0 # クロージャポインタ (x25) へ compose で取得したクロージャを保存
mov lr, x26 # lr の値を復元
mov x0, 123
# CallCls start: %x25
mov x26, lr # lr を退避
add x28, x28, 8
ldr x26, x25, 0 # x26 へ composed のアドレスを読み込み blr x26 # クロージャを呼び出し (composed が実行される)
sub x28, x28, 8
mov lr, x26
# CallCls end: %x25
mov x26, lr
add x28, x28, 8
bl _min_caml_print_int
sub x28, x28, 8
mov lr, x26
# main program ends
sub x28, x28, 16
ret
直したぞ！！！
末尾の CallCls は blr じゃなくて br で呼び出す必要があるみたい（そう言われると確かに）
不要なスタックへの退避を削除 & blr から br へ修正することでうまく動くようになったよ。
code:diff
diff --git a/AArch64/emit.ml b/AArch64/emit.ml
index 3d4ab9b..3afeb5b 100644
--- a/AArch64/emit.ml
+++ b/AArch64/emit.ml
@@ -193,31 +193,18 @@ and g' oc = function (* 各命令のアセンブリ生成 (caml2html: emit_gprim
g'_non_tail_if oc (NonTail(z)) e1 e2 "ble" "bgt"
(* 関数呼び出しの仮想命令の実装 (caml2html: emit_call) *)
| Tail, CallCls(x, ys, zs) -> (* 末尾呼び出し (caml2html: emit_tailcall) *)
- Printf.fprintf oc "\t# CallCls start: %s\n" x;
-
+ Printf.fprintf oc "\t# Tail CallCls start: %s\n" x;
let ss = stacksize () in
-
- (* lrをスタックへ退避 *)
- Printf.fprintf oc "\tmov %s, lr\n" (reg reg_tmp);
- Printf.fprintf oc "\tstr %s, %s, %d\n" (reg reg_tmp) (reg reg_sp) (ss - 8); - Printf.fprintf oc "\tadd %s, %s, %d\n" (reg reg_sp) (reg reg_sp) ss;
-
(* クロージャを呼び出し *)
Printf.fprintf oc "\tldr %s, %s, 0\n" (reg reg_sw) (reg reg_cl); - Printf.fprintf oc "\tblr %s\n" (reg reg_sw);
-
- (* lrをスタックから復元 *)
- Printf.fprintf oc "\tsub %s, %s, %d\n" (reg reg_sp) (reg reg_sp) ss;
- Printf.fprintf oc "\tldr %s, %s, %d\n" (reg reg_tmp) (reg reg_sp) (ss - 8); - Printf.fprintf oc "\tmov lr, %s\n" (reg reg_tmp);
-
- Printf.fprintf oc "\t# CallCls end: %s\n" x
+ Printf.fprintf oc "\tbr %s\n" (reg reg_sw);
+ Printf.fprintf oc "\t# Tail CallCls end: %s\n" x
| Tail, CallDir(Id.L(x), ys, zs) -> (* 末尾呼び出し *)
g'_args oc [] ys zs;
Printf.fprintf oc "\tb\t%s\n" x
| NonTail(a), CallCls(x, ys, zs) ->
- Printf.fprintf oc "\t# CallCls start: %s\n" x;
+ Printf.fprintf oc "\t# NonTail CallCls start: %s\n" x;
let ss = stacksize () in
@@ -243,7 +230,7 @@ and g' oc = function (* 各命令のアセンブリ生成 (caml2html: emit_gprim
(* lrをスタックから復元 *)
Printf.fprintf oc "\tmov lr, %s\n" (reg reg_tmp);
- Printf.fprintf oc "\t# CallCls end: %s\n" x
+ Printf.fprintf oc "\t# NonTail CallCls end: %s\n" x
| (NonTail(a), CallDir(Id.L(x), ys, zs)) ->
g'_args oc [] ys zs;
let ss = stacksize () in