条件分岐するRP2350コードを出力

sample/my_add.ml

条件分岐を含む以下のようなコードを動かしたい。

code:my_add.ml

let rec iszero x = if x = 0 then 1 else 0 in

let rec isone x = if x = 1 then 1 else 0 in

let rec myeq x y = if x = y then 1 else 0 in

let rec mygt x y = if x > y then 1 else 0 in

let rec myge x y = if x >= y then 1 else 0 in

let rec mylt x y = if x < y then 1 else 0 in

let rec myle x y = if x <= y then 1 else 0 in

print_int (iszero 0); print_newline (); (* 1 *)

print_int (iszero 1); print_newline (); (* 0 *)

print_int (isone 0); print_newline (); (* 0 *)

print_int (isone 1); print_newline (); (* 1 *)

print_int (myeq 0 0); print_newline (); (* 1 *)

print_int (myeq 1 1); print_newline (); (* 1 *)

print_int (myeq 0 1); print_newline (); (* 0 *)

print_int (mygt 0 0); print_newline (); (* 0 *)

print_int (mygt 0 1); print_newline (); (* 0 *)

print_int (mygt 1 0); print_newline (); (* 1 *)

print_int (myge 0 0); print_newline (); (* 1 *)

print_int (myge 0 1); print_newline (); (* 0 *)

print_int (myge 1 0); print_newline (); (* 1 *)

print_int (mylt 0 0); print_newline (); (* 0 *)

print_int (mylt 0 1); print_newline (); (* 1 *)

print_int (mylt 1 0); print_newline (); (* 0 *)

print_int (myle 0 0); print_newline (); (* 1 *)

print_int (myle 0 1); print_newline (); (* 1 *)

print_int (myle 1 0); print_newline (); (* 0 *)

print_int 999; print_newline ()

修正箇所

code:diff

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

index 9977a03..b34cf8a 100644

--- a/RP2350/emit.ml

+++ b/RP2350/emit.ml

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

| _ -> assert false);

Printf.fprintf oc "\tblr\n";

| Tail, IfEq(x, V(y), e1, e2) ->

- Printf.fprintf oc "\tcmpw\tcr7, %s, %s\n" (reg x) (reg y);

+ Printf.fprintf oc "\tcmp %s, %s\n" (reg x) (reg y);

g'_tail_if oc e1 e2 "beq" "bne"

| Tail, IfEq(x, C(y), e1, e2) ->

- Printf.fprintf oc "\tcmpwi\tcr7, %s, %d\n" (reg x) y;

+ Printf.fprintf oc "\tcmp %s, %d\n" (reg x) y;

g'_tail_if oc e1 e2 "beq" "bne"

| Tail, IfLE(x, V(y), e1, e2) ->

- Printf.fprintf oc "\tcmpw\tcr7, %s, %s\n" (reg x) (reg y);

+ Printf.fprintf oc "\tcmp %s, %s\n" (reg x) (reg y);

g'_tail_if oc e1 e2 "ble" "bgt"

| Tail, IfLE(x, C(y), e1, e2) ->

Printf.fprintf oc "\tcmpwi\tcr7, %s, %d\n" (reg x) y;

g'_tail_if oc e1 e2 "ble" "bgt"

| Tail, IfGE(x, V(y), e1, e2) ->

- Printf.fprintf oc "\tcmpw\tcr7, %s, %s\n" (reg x) (reg y);

+ Printf.fprintf oc "\tcmp %s, %s\n" (reg x) (reg y);

g'_tail_if oc e1 e2 "bge" "blt"

| Tail, IfGE(x, C(y), e1, e2) ->

- Printf.fprintf oc "\tcmpwi\tcr7, %s, %d\n" (reg x) y;

+ Printf.fprintf oc "\tcmp %s, %d\n" (reg x) y;

g'_tail_if oc e1 e2 "bge" "blt"

| Tail, IfFEq(x, y, e1, e2) ->

Printf.fprintf oc "\tfcmpu\tcr7, %s, %s\n" (reg x) (reg y);

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

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

and g'_tail_if oc e1 e2 b bn =

let b_else = Id.genid (b ^ "_else") in

- Printf.fprintf oc "\t%s\tcr7, %s\n" bn b_else;

+ Printf.fprintf oc "\t%s %s\n" bn b_else;

let stackset_back = !stackset in

g oc (Tail, e1);

Printf.fprintf oc "%s:\n" b_else;

@@ -224,7 +224,7 @@ and g'_tail_if oc e1 e2 b bn =

and g'_non_tail_if oc dest e1 e2 b bn =

let b_else = Id.genid (b ^ "_else") in

let b_cont = Id.genid (b ^ "_cont") in

- Printf.fprintf oc "\t%s\tcr7, %s\n" bn b_else;

+ Printf.fprintf oc "\t% s\tcr7, %s\n" bn b_else;

let stackset_back = !stackset in

g oc (dest, e1);

let stackset1 = !stackset in

diff --git a/sample/my_if.ml b/sample/my_if.ml

new file mode 100644

index 0000000..cc942b7

--- /dev/null

+++ b/sample/my_if.ml

@@ -0,0 +1,27 @@

+let rec iszero x = if x = 0 then 1 else 0 in

+let rec isone x = if x = 1 then 1 else 0 in

+let rec myeq x y = if x = y then 1 else 0 in

+let rec mygt x y = if x > y then 1 else 0 in

+let rec myge x y = if x >= y then 1 else 0 in

+let rec mylt x y = if x < y then 1 else 0 in

+let rec myle x y = if x <= y then 1 else 0 in

+print_int (iszero 0); print_newline (); (* 1 *)

+print_int (iszero 1); print_newline (); (* 0 *)

+print_int (isone 0); print_newline (); (* 0 *)

+print_int (isone 1); print_newline (); (* 1 *)

+print_int (myeq 0 0); print_newline (); (* 1 *)

+print_int (myeq 1 1); print_newline (); (* 1 *)

+print_int (myeq 0 1); print_newline (); (* 0 *)

+print_int (mygt 0 0); print_newline (); (* 0 *)

+print_int (mygt 0 1); print_newline (); (* 0 *)

+print_int (mygt 1 0); print_newline (); (* 1 *)

+print_int (myge 0 0); print_newline (); (* 1 *)

+print_int (myge 0 1); print_newline (); (* 0 *)

+print_int (myge 1 0); print_newline (); (* 1 *)

+print_int (mylt 0 0); print_newline (); (* 0 *)

+print_int (mylt 0 1); print_newline (); (* 1 *)

+print_int (mylt 1 0); print_newline (); (* 0 *)

+print_int (myle 0 0); print_newline (); (* 1 *)

+print_int (myle 0 1); print_newline (); (* 1 *)

+print_int (myle 1 0); print_newline (); (* 0 *)

+print_int 999; print_newline ()

動かしてみる。ちゃんと動いてそう。

code:sh

$ touch sample/my_if.ml && make clean min-caml min-caml.top sample/my_if.res

...

generating assembly...

arm-none-eabi-gcc -mcpu=cortex-m33 -mthumb -mfpu=fpv5-sp-d16 -mfloat-abi=hard -ffreestanding -nostdlib -Wall -Wextra -O2 -T linker.ld -nostdlib -Wl,-Map=main.map -o sample/my_if.elf sample/my_if.s startup.c stub.c libmincaml.S

qemu-system-arm \

-machine mps2-an505 \

-cpu cortex-m33 \

-m 16M \

-nographic \

-monitor none \

-kernel sample/my_if.elf

Hello from QEMU mps2-an505 Cortex-M33!

1

0

0

1

1

1

0

0

0

1

1

0

1

0

1

0

1

1

0

999

test/sum.ml

続いて、test/sum.ml を動かしてみる。

code:test/sum.ml

let rec sum x =

if x <= 0 then 0 else

sum (x - 1) + x in

print_int (sum 10000)

中間コードを確認

code:sh

$ rlwrap ./min-caml.top

# let src = "let rec sum x = if x <= 0 then 0 else sum (x - 1) + x in print_int (sum 10000)" in Virtual.f (Closure.f (Alpha.f (KNormal.f (Typing.f (MyParser.exp MyLexer.token (Lexing.from_string src))))));;

free variable print_int assumed as external

directly applying sum.7

directly applying sum.7

eliminating closure(s) sum.7

- : Asm.prog =

Asm.Prog ([],

body =

Asm.Let (("Ti3.11", Type.Int), Asm.Li 0,

Asm.Ans

(Asm.IfLE ("x.8", Asm.V "Ti3.11", Asm.Ans (Asm.Li 0),

Asm.Let (("Ti4.14", Type.Int), Asm.Li 1,

Asm.Let (("Ti5.13", Type.Int), Asm.Sub ("x.8", Asm.V "Ti4.14"),

Asm.Let (("Ti6.12", Type.Int),

Asm.Ans (Asm.Add ("Ti6.12", Asm.V "x.8"))))))));

ret = Type.Int}],

Asm.Let (("Ti1.10", Type.Int), Asm.Li 10000,

ビルドと実行

code:sh

$ touch test/sum.ml && make clean min-caml min-caml.top test/sum.res

修正箇所

code:diff

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

index b34cf8a..3e4b79e 100644

--- a/RP2350/emit.ml

+++ b/RP2350/emit.ml

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

| 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 "\taddi\t%s, %s, %d\n" (reg x) (reg y) z

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

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

+ | NonTail(x), Sub(y, V(z)) -> Printf.fprintf oc "\tsub %s, %s, %s\n" (reg x) (reg y) (reg z)

+ | NonTail(x), Sub(y, C(z)) -> Printf.fprintf oc "\tsub %s, %s, %d\n" (reg x) (reg y) z

| 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)

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

(* 退避の仮想命令の実装 (caml2html: emit_save) *)

| NonTail(_), Save(x, y) when List.mem x allregs && not (S.mem y !stackset) ->

save y;

- Printf.fprintf oc "\tstw\t%s, %d(%s)\n" (reg x) (offset y) (reg reg_sp)

| NonTail(_), Save(x, y) when List.mem x allfregs && not (S.mem y !stackset) ->

savef y;

Printf.fprintf oc "\tstfd\t%s, %d(%s)\n" (reg x) (offset y) (reg reg_sp)

| NonTail(_), Save(x, y) -> assert (S.mem y !stackset); ()

(* 復帰の仮想命令の実装 (caml2html: emit_restore) *)

| NonTail(x), Restore(y) when List.mem x allregs ->

- Printf.fprintf oc "\tlwz\t%s, %d(%s)\n" (reg x) (offset y) (reg reg_sp)

| NonTail(x), Restore(y) ->

assert (List.mem x allfregs);

Printf.fprintf oc "\tlfd\t%s, %d(%s)\n" (reg x) (offset y) (reg reg_sp)

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

Printf.fprintf oc "\tcmp %s, %s\n" (reg x) (reg y);

g'_tail_if oc e1 e2 "ble" "bgt"

| Tail, IfLE(x, C(y), e1, e2) ->

- Printf.fprintf oc "\tcmpwi\tcr7, %s, %d\n" (reg x) y;

+ Printf.fprintf oc "\tcmp %s, %d\n" (reg x) y;

g'_tail_if oc e1 e2 "ble" "bgt"

| Tail, IfGE(x, V(y), e1, e2) ->

Printf.fprintf oc "\tcmp %s, %s\n" (reg x) (reg y);

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

Printf.fprintf oc "\tcmpw\tcr7, %s, %s\n" (reg x) (reg y);

g'_non_tail_if oc (NonTail(z)) e1 e2 "beq" "bne"

| NonTail(z), IfEq(x, C(y), e1, e2) ->

- Printf.fprintf oc "\tcmpwi\tcr7, %s, %d\n" (reg x) y;

+ Printf.fprintf oc "\tcmp %s, %d\n" (reg x) y;

g'_non_tail_if oc (NonTail(z)) e1 e2 "beq" "bne"

| NonTail(z), IfLE(x, V(y), e1, e2) ->

Printf.fprintf oc "\tcmpw\tcr7, %s, %s\n" (reg x) (reg y);

g'_non_tail_if oc (NonTail(z)) e1 e2 "ble" "bgt"

| NonTail(z), IfLE(x, C(y), e1, e2) ->

- Printf.fprintf oc "\tcmpwi\tcr7, %s, %d\n" (reg x) y;

+ Printf.fprintf oc "\tcmp %s, %d\n" (reg x) y;

g'_non_tail_if oc (NonTail(z)) e1 e2 "ble" "bgt"

| NonTail(z), IfGE(x, V(y), e1, e2) ->

Printf.fprintf oc "\tcmpw\tcr7, %s, %s\n" (reg x) (reg y);

g'_non_tail_if oc (NonTail(z)) e1 e2 "bge" "blt"

| NonTail(z), IfGE(x, C(y), e1, e2) ->

- Printf.fprintf oc "\tcmpwi\tcr7, %s, %d\n" (reg x) y;

+ Printf.fprintf oc "\tcmp %s, %d\n" (reg x) y;

g'_non_tail_if oc (NonTail(z)) e1 e2 "bge" "blt"

| NonTail(z), IfFEq(x, y, e1, e2) ->

Printf.fprintf oc "\tfcmpu\tcr7, %s, %s\n" (reg x) (reg y);

@@ -242,7 +242,7 @@ and g'_args oc x_reg_cl ys zs =

(0, x_reg_cl)

ys in

List.iter

- (fun (y, r) -> Printf.fprintf oc "\tmr\t%s, %s\n" (reg r) (reg y))

+ (fun (y, r) -> Printf.fprintf oc "\tmov %s, %s\n" (reg r) (reg y))

(shuffle reg_sw yrs);

let (d, zfrs) =

List.fold_left

実行した結果。いい感じに動いてそう。

code:sh

$ touch test/sum.ml && make clean min-caml min-caml.top test/sum.res

...

generating assembly...

arm-none-eabi-gcc -mcpu=cortex-m33 -mthumb -mfpu=fpv5-sp-d16 -mfloat-abi=hard -ffreestanding -nostdlib -Wall -Wextra -O2 -T linker.ld -nostdlib -Wl,-Map=main.map -o test/sum.elf test/sum.s startup.c stub.c libmincaml.S

qemu-system-arm \

-machine mps2-an505 \

-cpu cortex-m33 \

-m 16M \

-nographic \

-monitor none \

-kernel test/sum.elf

Hello from QEMU mps2-an505 Cortex-M33!

50005000

test/gcd.ml

gcd.ml も対応してみる。

code:test/gcd.ml

let rec gcd m n =

if m = 0 then n else

if m <= n then gcd m (n - m) else

gcd n (m - n) in

print_int (gcd 21600 337500)

修正箇所

code:diff

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

index 3e4b79e..4f313e8 100644

--- a/RP2350/emit.ml

+++ b/RP2350/emit.ml

@@ -59,13 +59,7 @@ let rec g oc = function (* 命令列のアセンブリ生成 (caml2html: emit_g)

and g' oc = function (* 各命令のアセンブリ生成 (caml2html: emit_gprime) *)

(* 末尾でなかったら計算結果をdestにセット (caml2html: emit_nontail) *)

| NonTail(_), Nop -> ()

- | NonTail(x), Li(i) when -32768 <= i && i < 32768 -> Printf.fprintf oc "\tldr %s, =%d\n" (reg x) i

- | NonTail(x), Li(i) ->

- let n = i lsr 16 in

- let m = i lxor (n lsl 16) in

- let r = reg x in

- Printf.fprintf oc "\tlis\t%s, %d\n" r n;

- Printf.fprintf oc "\tori\t%s, %s, %d\n" r r m

+ | NonTail(x), Li(i) -> Printf.fprintf oc "\tldr %s, =%d\n" (reg x) i

| NonTail(x), FLi(Id.L(l)) ->

let s = load_label (reg reg_tmp) l in

Printf.fprintf oc "%s\tlfd\t%s, 0(%s)\n" s (reg x) (reg reg_tmp)

@@ -73,7 +67,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 "\taddi\t%s, %s, %d\n" (reg x) (reg y) z

出力結果。2700が返ればOK

code:sh

$ touch test/gcd.ml && make clean min-caml min-caml.top test/gcd.res

...

qemu-system-arm \

-machine mps2-an505 \

-cpu cortex-m33 \

-m 16M \

-nographic \

-monitor none \

-kernel test/gcd.elf

Hello from QEMU mps2-an505 Cortex-M33!

2700

test/fib.ml

フィボナッチ数も計算できた

code:test/fib.ml

let rec fib n =

if n <= 1 then n else

fib (n - 1) + fib (n - 2) in

print_int (fib 10)

https://gyazo.com/efd229f1b58d07bdef875501dd3db077