F# to ocaml(4)

トラ技を買ってみた。自分の金で買うなんて何年ぶりだろう？会社勤めをしてる時は、会社に置いてあったから買う事も無かったしなあ。自由の身になった時は、興味がソフトに移ってしまっていて、全く手を出さなかったからなあ。

それが突然興味が出たって事は、特集目当てですよ。デジタル時代のMyラジオ製作ですって。 RFワールドにも同じようなのが有ったけど、あの本はこちらでは手に入らなかったから、その反動もあるのかな。

雑誌が薄くなりましたね。広告が減ったから。もう電波少年はいなくなった、それとも中少企業の技術者も減った？広告はWebでって事になったのかな。昔、出入りの業者さんにトラ技に広告出すのに幾ら必要なんて興味本位で聞いた事がある。そしたら、最小のヒトコマで 5万円との事だった。自前でサーバー立てて広告を打った方が得だろうね。今のご時勢。

興味深く広告を見たら、TIがチップでも部品を売り出しているのね。最低単位が10個って事だけど、面白そうな取り組みだね。簡単に試験したダイと、真面目に試験したゴールデンチップと２種類のうちから懐具合で選べるのが面白い。日の丸ICは品質過剰で世界商戦に敗れた感があるんで、TI流がグローバルスタンダードなんだな。

で、SDRですよ。ハードが安く手に入るようだ。ワンセグ用のドングルがヨーロッパで大量に消費され、そのおこぼれが東洋にまでやってきたためらしい。

DS-DT305とかワンセグRX DVB-T+DAB+FM R820T高性能受信機を使って、ごにょごにょやるみたい。直接パソコンに接続してもいいし、ラズベリーパイと組み合わせるのがトレンドらしい。 ICOMなんて無線機メーカーのWebにも、「超かんたんSDR(ソフトウエアラジオ)入門」なんて記事が載るぐらいだから、いつの間にか世間から取り残されているな。

知らないと言えば解説記事の中に有ったんだけど、デシメーションって考え方が人生初見でしたよ。A/Dの出力を間引き。ただ間引きするんじゃ、何の誤利益も無いんで、積分して差分を取るらしい。こうする事により、データ量が減って後段のフィルター設計が楽になる。積分効果により、実質的なA/D分解能が上がるそうだ。

CQ出版からワンセグUSBドングルで作るオールバンド・ソフトウェア・ラジオなんていうムックが出てたのね。更に、ちょっと高いけど、実験キットが出てて、その解説本も発売されてるようだ。また、関連で、お手軽ARMコンピュータラズベリー・パイでI/O なんてのも出てるし、ブームになってるな。rubyも動くようだし、ちょっと遊ぶには面白いかもしれないな。

電卓ぐらいになるかな？

この間からずっとやってるretroのocaml移植、やっとpromptが出る所まで漕ぎつけた。これで当初の目的は達した訳だけど、ちょっと欲が出てきた。電卓ぐらいにはなるかな？おっと、その前にvmの各命令のテストカバー率でも調べておくかな。promptが出るまでに使った命令を比率化しておけば良いだろう。ちょっと長いパイプを施設してみました。数値(だけのcall命令)は、一応dcallって名前に置き換えておきました。

[sakae@pcbsd ~/src/ml]$ cut -f 2 Hist.log | sed -e 's/[0-9].*/dcall/' | sort | uniq -c | sort -nr
 310 rtn
 302 dcall
 273 lit
 106 swap
  87 push
  74 inc
  71 dup
  70 fetch
  58 pop
  58 dec
  53 z_rtn
  52 out
  44 jmp
  40 drop
  29 eq_jmp
  26 ne_jmp
  23 wait
  13 store
   6 in
   2
   1 xor
   1 sub

命令の種類が30あるうちの20種しか使ってません。(空白の命令は、retroからの改行を誤カウントしてるためです) 後の10種はまだ未確認。手動でコードを設定して、単独でテストするって方法も頭を過ぎりましたが、もぐら叩きが楽しそうなのでいきなり、vmを働かせてみます。

[sakae@pcbsd ~/src/ml]$ ocaml z.ml
Retro 11.6

ok  1
1
ok  2
2
ok  +
+
ok  putn
putn Exception: Failure "Underflow".
[sakae@pcbsd ~/src/ml]$ ocaml z.ml
Retro 11.6

ok  1
1
ok  putn
putn A
ok  bye
bye

あれま？ putn(TOSを数値と思って表示する)が挙動不審ですよ。化けるのより、落ちるの方が、直すのが簡単だと思うので、追いかけてみる。まずは、ICEだかロジアナにかけて、検体を採取だな。

[sakae@pcbsd ~/src/ml]$ ruby retro.rb > Ref.log
1
2
+
putn
^Cretro.rb:69:in `getbyte': Interrupt
        from retro.rb:69:in `get_char'
        from retro.rb:111:in `handle_devices'
        from retro.rb:377:in `process'
        from retro.rb:429:in `<main>'

[sakae@pcbsd ~/src/ml]$ ocaml z.ml > Bad.log
1
2
+
putn
Exception: Failure "Underflow".
[sakae@pcbsd ~/src/ml]$ wc *.log
  114973  344904 11003317 Bad.log
  115454  461792 11682881 Ref.log
  230427  806696 22686198 total

たかが足し算するだけで、こんなに命令を実行してるなんて、ちょっと驚き、ってか、効率が悪すぎるような気がしますね。まあ、それはさておき、これだけの行数が有ると、相違点を探すのも至難の業だなあ。こういう汚れ仕事はコンピュータにやらせましょ。相違が発生した所かそれ以前に問題があるはずだから。。

[sakae@pcbsd ~/src/ml]$ cut -f 1 Ref.log > /tmp/ref
[sakae@pcbsd ~/src/ml]$ cut -f 1 Bad.log > /tmp/bad
[sakae@pcbsd ~/src/ml]$ cmp /tmp/ref /tmp/bad
/tmp/ref /tmp/bad differ: char 11517, line 1889

promptが出て来るまで、約1700ステップを費やしていたから、コマンドを打ち込んで直ぐに差異が表れたって事か。なんてこったい。

[sakae@pcbsd ~/src/ml]$ cat -n Ref.log | head -n 1890 | tail -n 30 > /tmp/ref
[sakae@pcbsd ~/src/ml]$ cat -n Bad.log | head -n 1890 | tail -n 30 > /tmp/bad
[sakae@pcbsd ~/src/ml]$ cd /tmp
[sakae@pcbsd /tmp]$ cat ref bad | sort
     :
  1888  1755:           [17846;0;49;49;999744]  [5901;5817;17852;13032;17856;17899;19025;19058;19087;4144;4292;4368;8390]
  1888  1755:   rtn     [17846,0,49,49,999744,]  [5901,5817,17852,13032,17856,17899,19025,19058,19087,4144,4292,4368,8390,]
  1889  5902:           [17846;0;49;49;999744]  [5817;17852;13032;17856;17899;19025;19058;19087;4144;4292;4368;8390]
  1889  5904:   1385    [17846,0,49,49,999744,]  [5817,17852,13032,17856,17899,19025,19058,19087,4144,4292,4368,8390,]
  1890  1387:   push    [17846,0,49,49,999744,]  [5904,5817,17852,13032,17856,17899,19025,19058,19087,4144,4292,4368,8390,]
  1890  5903:           [17846;0;49;49;999744]  [5817;17852;13032;17856;17899;19025;19058;19087;4144;4292;4368;8390]

おいらの80桁端末では、行長すぎて、折り返し表示されてしまい、おちおち見てられん。 Xを上げて、横に広い端末を作ってもいいんだけど、おいらは昔の人。80桁端末で快適に表示する方法は無いかな？

ふと、スタックの全データを表示するなんて無駄じゃん。大体、演算の対象がスタック上の２つのデータしかないんだから、せいぜい３個ぐらいのデータ表示で十分と気付く。

let mon3 rx =
  let si i = string_of_int i
  and sis i = string_of_int i ^ "; "
  in match !rx with
    [] -> "[]"
  | [a] -> "[" ^ si a ^ "]"
  | [a; b] -> "[" ^ sis a ^ si b ^ "]"
  | [a; b; c] -> "[" ^ sis a ^ sis b ^ si c ^ "]"
  | a::b::c::_ -> "[" ^ sis a ^ sis b ^ sis c ^ "..]"

let rec exec () =
  if not (!halt) then
    begin
      Printf.printf "%d:\t\t%s  %s\n" !ip (mon3 data) (mon3 address) ;
      execOne();
      ip := !ip + 1 ;
      exec ()
    end ;;

letで宣言してる内部関数、無くてもいいんだけど、入力文字数短縮の為。ocamlの関数名を決めた人、センス悪すぎ。まあ、フランス人に英語で考えろって言ったら見紛えちゃうだろうから無理は無いか。ocamlにもprintfなんてのが有った。不定個の引数を関数型言語はどうやって処理してるのだろう？後でPrintfモジュールを覗いておこう。

def ds3(x)
  def is(x, n) x.nth(n).to_s end
  def iss(x, n) x.nth(n).to_s + ", " end
  case x.depth
    when 0 then
      "[]"
    when 1 then
      "[" + is(x,0) + "]"
    when 2 then
      "[" + iss(x,0) + is(x,1) + "]"
    when 3 then
      "[" + iss(x,0) + iss(x,1) + is(x,2) + "]"
  else
      "[" + iss(x,0) + iss(x,1) + iss(x,2) + "..]"
  end
end

rubyでmatchもどきをやろうとしたら、こうなったぞ。 Rubyによる関数型プログラミングなんてのと対比すると、面白いかも知れない。

とまあ、道具を作って、今出てる虫を眺めてみたんだけど、虫取り方法がピンとこないので別アプローチしてみる。そもそも、おいらはプロンプトが出て来るまで移植が済んだら、ベンチをやってみたかったんだ。目的へ一直線でgoするか。

ocamlは早いのか？

ってな訳で、retroのベンチで作っておいたloop用のROM(retroImage)を持ってきた。走らせてみると

[sakae@pcbsd ~/src/ml]$ ocaml z.ml
Exception: Failure "hd".

あらま、虫が沸いてきた、と言うより新たなretroImageに隠れて虫が侵入きたんだな。そして繁殖したとな。クリーンなCPUのそれと比べてみよう。

   304  5819:           [23047]  [14237; 1000; 5619; ..]
   304  5819:   rtn     [23047]  [14237, 1000, 5619, ..]
   305  14238:          [23047]  [1000; 5619; 14248; ..]
   305  14238:  pop     [23047]  [1000, 5619, 14248, ..]
   306  14239:          [1000; 23047]  [5619; 14248; 23048; ..]
   306  14239:  loop    [1000, 23047]  [5619, 14248, 23048, ..]
   307  14235:          [23047]  [5619; 14248; 23048; ..]
   307  14235:  push    [999, 23047]  [5619, 14248, 23048, ..]
   308  14236:          []  [23047; 5619; 14248; ..]
   308  14236:  dup     [23047]  [999, 5619, 14248, ..]

空のスタック(トップ)を複製しようとして、落ちたんだな。loop命令の後ocamlのvmの方はスタックが一段浅くなってる。call内に虫が潜んでいるな。

loop命令は外にくくり出したloopマクロに丸投げしてた。じっと眼をこらしていたら虫が見えたぞ。括弧忘れで虫が逃げ出したんだな。毎度、カッコ悪い。

[sakae@pcbsd ~/src/ml]$ time ocaml z.ml
real    0m41.562s
user    0m40.706s
sys     0m0.134s

以前mono上でF#でやった時には、46秒だったから、ocamlの方が速いな。

[sakae@pcbsd ~/src/ml]$ ocamlopt z.ml
[sakae@pcbsd ~/src/ml]$ time ./a.out
real    0m7.349s
user    0m7.220s
sys     0m0.064s

やっとコンパイルして実行だ。mono上では13秒、C言語だと4秒だったな。

出来上がったa.outは、極々普通なもの

[sakae@pcbsd ~/src/ml]$ file a.out
a.out: ELF 32-bit LSB executable, Intel 80386, version 1 (FreeBSD), dynamically linked (uses shared libs), for FreeBSD 9.1, not stripped
[sakae@pcbsd ~/src/ml]$ ldd a.out
a.out:
        libm.so.5 => /lib/libm.so.5 (0x2807f000)
        libc.so.7 => /lib/libc.so.7 (0x28099000)

ocamloptでコンパイルする時に、-Sを付けるとアセンブラ出力が得られる。アセンブリ具合も見ておくか

        .text
        .align  16
        .globl  camlZ__incIp_1083
camlZ__incIp_1083:
.L207:
        movl    camlZ + 12, %eax
        addl    $2, (%eax)
        movl    $1, %eax
        ret
        .type   camlZ__incIp_1083,@function
        .size   camlZ__incIp_1083,.-camlZ__incIp_1083

メインが何処に有るか探したけど見つからず。しょうがないので、-gを付けてコンパイルしたやつをgdbに喰わせてみた。適当な所で止めて、呼び出し具合を確認。

[sakae@pcbsd ~/src/ml]$ gdb a.out
GNU gdb 6.1.1 [FreeBSD]
  :
(gdb) b camlZ__loop_1089
Breakpoint 1 at 0x804a280
(gdb) run
Starting program: /usr/home/sakae/src/ml/a.out
(no debugging symbols found)...(no debugging symbols found)...(no debugging symbols found)...
Breakpoint 1, 0x0804a280 in camlZ__loop_1089 ()
(gdb) l
No symbol table is loaded.  Use the "file" command.
(gdb) bt
#0  0x0804a280 in camlZ__loop_1089 ()
#1  0x0804a7fa in camlZ__exec_1100 ()
#2  0x0804a9d2 in camlZ__entry ()
#3  0x0804963d in caml_startup__code_begin ()
#4  0x0805bb76 in caml_start_program ()
#5  0x00000000 in ?? ()
#6  0xbfbfe7a8 in ?? ()
#7  0xbfbfe80c in ?? ()
#8  0x00000001 in ?? ()
#9  0x08049620 in frame_dummy ()
Previous frame inner to this frame (corrupt stack?)

camlZ__entryがおいらの書いたコードへの入り口、いわゆるtoplevelの環境を実現してる。このルーチンの最後はretになってた。ocamlが用意したcrt.o相当へ帰って行くんだな。

BUG入りソース

いいかげん飽きてきたんで、BUG入りだけど移植したソースを掲げて置きます。昆虫食が好きな方はどうぞ味わってみて下さい。

(* import retro.fsx *)

let mem_size = 1_000_000
let image_file = "retroImage"
let ports_size = 12

let ip = ref 0
let ports = Array.make ports_size 0
let memory = Array.make mem_size 0xdeadbee
let halt = ref false

let data = ref []
let address = ref []

let pushVal d x =    d := x :: !d
let popVal d () = match !d with h :: t -> d := t; h | _ -> failwith "Underflow"
let push = pushVal data
let pushr = pushVal address
let pop = popVal data
let popr = popVal address
let tos () = List.hd (!data)

let (|>) (x: int) f = f x ;;

(* for debug, monitor data or address stack *)
let mon3 rx =
  let si i = string_of_int i
  and sis i = string_of_int i ^ "; "
  in match !rx with
    [] -> "[]"
  | [a] -> "[" ^ si a ^ "]"
  | [a; b] -> "[" ^ sis a ^ si b ^ "]"
  | [a; b; c] -> "[" ^ sis a ^ sis b ^ si c ^ "]"
  | a::b::c::_ -> "[" ^ sis a ^ sis b ^ sis c ^ "..]"

let load () =
  let b4 = Array.make 4 0
  in let binReader = open_in_bin image_file
     in for i = 0 to  (in_channel_length binReader / 4  - 1) do
       b4.(0) <- input_byte binReader;   (* LSB *)
       b4.(1) <- input_byte binReader;
       b4.(2) <- input_byte binReader;
       b4.(3) <- input_byte binReader;
       memory.(i) <- b4.(3) lsl 24 + b4.(2) lsl 16 + b4.(1) lsl 8 + b4.(0)
       done;
     close_in binReader ;;

let key () = input_byte stdin ;;

let devices () =
  if ports.(0) = 0 then  ports.(0) <- 1 ;
  if ports.(1) = 1 then ports.(1) <- key () ;
  if ports.(2) = 1 then
    begin
      ports.(2) <- 0 ;
      let x = pop () in
      if x < 0 then print_char '?'
      else (print_char (char_of_int x) ; flush stdout; )
    end ;
  ports.(5) <- match ports.(5) with
  | -1 -> mem_size
  | -5 -> List.length (!data)
  | -6 -> List.length (!address)
  | -9 -> halt := true; 0
  | _ -> 0 ;;

let dyadic fn = let x = pop () in fn (pop ()) x |> push ;;
let dyadic2 fn = let x, y = fn (pop ()) (pop ()) in push x; push y ;;
let incIp () = ip := (!ip) + 1 ;;
let condJump fn =
  let x = pop () in
  if fn (pop ()) x then ip := memory.(!ip + 1) - 1 else incIp () ;;
let jump () =
  ip := memory.(!ip) - 1 ;
  if memory.(!ip + 1) = 0 then incIp () ;
  if memory.(!ip + 1) = 0 then incIp () ;;
let drop () = pop () |> ignore ;;
let loop () =
  pop () - 1 |> push ;
  if tos () > 0 then ip := memory.(!ip + 1) - 1
  else (incIp (); drop ()) ;;

let execOne () =
  match memory.(!ip) with
    0 -> ()   (* nop *)
  | 1 -> ( incIp (); memory.(!ip) |> push )   (* lit *)
  | 2 -> tos () |> push   (* dup *)
  | 3 -> drop ()   (* drop *)
  | 4 -> dyadic2 (fun x y -> y, x)   (* swap *)
  | 5 -> pop () |> pushr   (* push *)
  | 6 -> popr () |> push   (* pop *)
  | 7 -> loop ()   (* loop *)
  | 8 -> ( incIp (); jump () )   (* jmp *)
  | 9 -> ip := popr ()   (* rtn *)
  | 10 -> condJump (>)   (* gt_jmp *)
  | 11 -> condJump (<)   (* lt_jmp *)
  | 12 -> condJump (<>)  (* ne_jmp *)
  | 13 -> condJump (=)   (* eq_jmp *)
  | 14 -> memory.(pop ()) |> push   (* fetch *)
  | 15 -> let p = pop () in let v = pop () in memory.(p) <- v   (* store *)
  | 16 -> dyadic (+)   (* add *)
  | 17 -> dyadic (-)   (* sub *)
  | 18 -> push (pop () * pop ())   (* mul *)
  | 19 -> dyadic2 (fun x y -> y / x, y mod x)   (* divmod *)
  | 20 -> dyadic (land)   (* and *)
  | 21 -> dyadic (lor)   (* or *)
  | 22 -> dyadic (lxor)  (* xor *)
  | 23 -> dyadic (lsl)   (* lsl *)
  | 24 -> dyadic (asr)   (* asr *)
  | 25 -> if tos () = 0 then (drop (); ip := popr ())   (* z_ret *)
  | 26 -> pop () + 1 |> push   (* inc *)
  | 27 -> pop () - 1 |> push   (* dec *)
  | 28 -> let x = pop () in ports.(x) |> push; ports.(x) <- 0   (* in *)
  | 29 -> let p = pop () in let v = pop () in ports.(p) <- v   (* out *)
  | 30 -> devices ()   (* wait *)
  | _ -> (pushr !ip; jump ()) ;;   (* call by op-data *)

let rec exec () =
  if not (!halt) then
    begin
      Printf.printf "%d:\t\t%s  %s\n" !ip (mon3 data) (mon3 address) ;
      execOne();
      ip := !ip + 1 ;
      exec ()
    end ;;

load () ;;
exec () ;;