F# to ocaml(3)

初めての衛星中継はアメリカからだった。そして送られて来た映像は、子供心にもショッキングなものであった。あれから幾年月、悲劇の人を父にする娘さんが、大使として日本にやって来ると言う。アメリカのブランド戦術が見え隠れする今日この頃であります。

で、その人の決意表明記者会見に、方丈記なんてのが出てきてた。日本人として恥ずかしながらしらんかったぞ。これはいかん、おいらも日本人にならんとな。アプルの本屋へ行ったらちゃんと無料で読めるやつが置いてあった。こうして、日本人のたしなみを遅まきながら身に着けようと思ったのです。そして、更に古典って言う事で、源氏物語ですよ。

源氏物語は、1000年の時を経て、いろいろな人が解説してる。与謝野女史、お聖さん、瀬戸内さん等々。あぷるに置いてあったのは、著作権切れの与謝野バージョン。色々な巻があって、何処から読み始めれば良いの？源氏物語攻略本（こういう表現はおかしいかな？）は無いものか？

たまたま、図書館へ行ったら新刊コーナーに『見る・知る・読む源氏物語』(勉誠出版) なんて言う、おいらにぴったりな本が置いてあったので借りてきた。早稲田大学の文学名誉教授の中野先生の解説によるもの。

おいら、本はあとがきから読む事にしてる。この本もおいらの流儀に習って読んでみると衝撃的な事が書かれていた。

とある日本大使(夫妻)が外国へ赴任した。もっかの大使夫人の悩みは、同伴で出席するパーティらしい。曰く、乾杯が終わってくつろいだ雰囲気になると、相手側夫人が近寄ってきて、源氏物語の話を仕掛けてくるそうだ。英文科出身の夫人は、源氏が分からないので、グラスを持ったまま、逃げ回ることしきりだそうだ。で、旦那はそんな夫人を見て、パーティでは、ちっとも親睦にならないとこぼしたとか。さぞや、夫人も肩身が狭いでしょうな。

おいらも、そんな事にならないよう、古典に親しむ事にするか。借りてきた本には、巻の順番(それぞれの巻には桐壷とか夕顔とかのタイトル名が付いている)が載ってたんでメモでもして読書TODOにでも入れておくかな。このTODOも最近は深くなる一方で、絶対にoverflowや underflowを起しません。ただただ、depthが深くなる一方です。

tidi_of_ocaml

次のBugの退治を始める前に、雑然としたソースをちょっと小奇麗にしておこうと思った。今までemacs上のtuareg-modeを漫然と使ってきたんだけど、どんな機能が隠れているやら調べておこう。

X上でemacsを使っていれば、メニューをダラーンと下げた一番下にHelpがあるのでそれを見れば良い。CUIなおいらは、C-h m して、モードの説明を見るんだな。

それぞれのletの書式を整えるには、letの所にカーソルを合わせて、C-c C-q すれば標準と思われる書式に揃えてくれるよ。letのそれぞれに付いてやらないといけないので、テストが完了した時点で、小まめにやるのが良いだろう。まとめてやろうとすると退屈だから。 emacsのマクロを覚えて自動化だな。perl-tidiみたいな外部ツールに頼るのは、アホなemacs使いだと思われるぞ。後で、キーボードマクロの使い方を調べておく事。

それから、begin end みたいな雛形を入れる機能があるようだ。おいらは、コメントになる、(* *) を、自動挿入したいんだけど、そのキーシーケンス、 C-c . c は、クラスの為に予約されてた。こういう覚え易いのがclassなんて使わない呪文の為に予約されてるなんて嘆かわしい。事実、結構ocamlを使いこなしている方も、ocamlのoは忘れていいよって仰ってる。

そんな訳なんで、C-c . c で、コメントの雛形が挿入出来るようにしよう。tuareg.elを覗いて、それらしいのを探すと、スケルトンなんてのがいろいろと定義されてた。悪いと承知の上で、次のように書き換え。

(define-skeleton tuareg-insert-class-form
  "Insert a nicely formatted comment form, leaving a mark middle point"
  nil
  "(* " > _ " *)" > \n)

これで、すぐにコメントを書けるようになったよ。以上、改造終了。で、vmの各op-codeにコメントを入れてみた。

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

おいらに取っちゃ、op-codeがICのピン番号みたいに見えるぞ。そして矢印は出力端子って事で、そうすると、コメントは、信号名に思えてくるんで、番号の近くに置きたかったんだ。でも、そうしちゃうとtuaregの整形ルーチンが旨く働かなくなっちゃうんで断念。何だか、整形も正規表現を駆使してるっぽいので、余り変な事はしない方が、身の為だろう。

何だか、上記がハードの回路図に見えてきたぞ。えっと、デコードの石はSN7442ぐらいかな。あの石は確かBCD-10進のデコーダだったな。ニキシー菅のセグメントドライバーに使われてて、耐圧不足で良く壊れたっけ。今から40年ぐらい前の話ですな。

コンピュータの回路も、命令のデコーダーの出力ったら、接続先はたいがい各命令の制御ゲートと決まっていた。（SICPの５章だかに説明が出てたな）よって、自分の持ってる回路図には、アセンブラの命令名を手書きしてたな。ハードもソフトも一緒だよ。興が乗ったら、 Hello Worldから始めるFPGAなんてのも、本当にハードっぽくて面白いかも知れんな。以上、じじいの昔話は終了。

ICEまたはロジアナ

さて、前回からの続きで、新しい虫に遭遇します。(vm移植の目標は、retroのプロンプトが出て来る所まで、ややこしいファイルシステムの扱いはバッサリ省略してます)

[sakae@pcbsd ~/src/ml]$ ocaml
        Objective Caml version 3.12.1

# #use "z.ml" ;;
  :
val exec : unit -> unit = <fun>
- : unit = ()
Exception: Failure "Underflow".
# ip ;;
- : int ref = {contents = 1345}
# memory.(1345) ;;
- : int = 30
# data ;;
- : int list ref = {contents = []}
# address ;;
- : int list ref = {contents = [7651; 7659; 9656]}

Stack underflowエラーを喰らって、落ちてしまいました。原因を、 stackOverflowの皆さんに尋ねてみましょうか。きっと、袋叩きに遭うだろうな。まずは、自助努力。

トレースしましょ。exec ()の中に、print式を埋め込みました。

let rec exec () =
  if not (!halt) then begin
    print_int !ip; print_string ": "; mon data;
    execOne();
      :

[sakae@pcbsd ~/src/ml]$ ocaml z.ml
0: []
9656: []
7657: []
7659: [-1]
7648: [-1]
7650: [5; -1]
7651: []
1340: []
1342: [0]
1344: [0; 0]
1345: []
Exception: Failure "Underflow".

はて、これが正しいのやら、間違っているのやら、rubyで書かれたvmを標準CPU (正しく動く石の事を、ゴールデン・デバイスって言うそうです)と思って正解を採取しておきましょ。それには、ICE（イン・サーキット・エミュレータ）かロジアナを仕掛けます。まあ、ICEも自作しますがね。

# -----------------------------------------------------------------------------
OPTBL = ["nop", "lit", "dup", "drop", "swap", "push", "pop", "call", "jmp",
"rtn", "gt_jmp", "lt_jmp", "ne_jmp", "eq_jmp", "fetch", "store", "add",
"sub", "mul", "divmod", "and", "or", "xor", "lsl", "asr", "z_rtn",
"inc", "dec", "in", "out", "wait"]

def n2op(ip)
  op = @memory[ip]
  ops = op > 30 ? op.to_s : OPTBL[op]
  return ops
end

def ds(x)
  d =x.depth
  return "EMPTY" if d == 0
  rs = "[" ; n =0
  while d > n do rs << (x.nth(n).to_s + ",") ; n = n + 1 end
  return ( rs + "]" )
end
# -----------------------------------------------------------------------------
while @ip < 100000 do
  printf("%d:\t%s\t%s  %s\n", @ip, n2op(@ip), ds(@stack), ds(@address))
  process()
  @ip = @ip + 1
end

ruby.rbの場合、process()ってのが、１命令の実行ルーチンになってるので、その前にリソースの状態表示するように、プローブを埋め込みました。

本当のロジアナだと、機能豊富で、ある命令が出てきたら表示を始めろとか指定出来るんですけど、そういうのは、ばっさり省略。

実行は次のようにします。

[sakae@pcbsd ~/src/ml]$ ruby retro.rb >Hist.log
^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>'

数秒待ってから、強制終了。これで、retroがプロンプトを表示するまでの命令サイクルのログが取得できました。wc Hist.logしたら、1699行って出てきました。1699ステップを実行して、コマンド待ちになるんだ。

[sakae@pcbsd ~/src/ml]$ head -n 15 Hist.log
0:      jmp     EMPTY  EMPTY
9656:   7657    EMPTY  EMPTY
7657:   lit     EMPTY  [9656,]
7659:   7648    [-1,]  [9656,]
7648:   lit     [-1,]  [7659,9656,]
7650:   out     [5,-1,]  [7659,9656,]
7651:   1338    EMPTY  [7659,9656,]
1340:   lit     EMPTY  [7651,7659,9656,]
1342:   lit     [0,]  [7651,7659,9656,]
1344:   out     [0,0,]  [7651,7659,9656,]
1345:   wait    EMPTY  [7651,7659,9656,]
1346:   rtn     EMPTY  [7651,7659,9656,]
7652:   lit     EMPTY  [7659,9656,]
7654:   in      [5,]  [7659,9656,]
7655:   rtn     [1000000,]  [7659,9656,]

左から、実行しようとした番地、その命令(数値の場合は、callと解釈されて、飛び先）、dataスタック、 addressスタック。スタックの表示は、左側がTOSにした。

尚、retro側が出してくる文字と、採取出力が、ミキシングされちゃっているんで、ちとわずらわしいけど、解析には便利かな、例えば

[sakae@pcbsd ~/src/ml]$ grep '^[a-z][0-9]' Hist.log
e1346:  rtn     [14,]  [2659,18704,18729,5619,18734,2819,7565,7693,9656,]
t1346:  rtn     [15,]  [2659,18704,18729,5619,18734,2819,7565,7693,9656,]
r1346:  rtn     [16,]  [2659,18704,18729,5619,18734,2819,7565,7693,9656,]
o1346:  rtn     [17,]  [2659,18704,18729,5619,18734,2819,7565,7693,9656,]
o1346:  rtn     [35,]  [2659,18704,18729,5619,18734,2819,8312,8387,]
k1346:  rtn     [36,]  [2659,18704,18729,5619,18734,2819,8312,8387,]

何となく、retro okと読める、1346番地付近は、文字列の出力ルーチンが有るんだな。

debug再開

waitってのは、retroのvm作者さんが付けた命令名だけど、ソースを読む限りでは、デバイス動作のstartトリガーっぽい。負論理で動作してて、ports.(0)が通常は１、動作開始の時は０にする。そして、デバイスの状態が定まると１に復帰する。ポート番号が１以上のものは、それぞれの固定デバイスになってる。

最低限のデバイスを定義したんで、まだ不足が有るかも知れないけど、現状は下記の通り

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) ;
    end ;
  ports.(5) <- match ports.(5) with
  | -1 -> mem_size
  | -5 -> List.length (!data)
  | -6 -> List.length (!address)
  | -9 -> halt := true; 0
  | _ -> 0 ;;

落ちていた原因は、posts.(2)の所で、begin .. end で囲んでいなかった為、popが外部に露出され、実行されちゃたんだ。（本来は、ports.(5)の中のメモリーサイズの取得リクエストだった。）

こういった、コードを書いた人の意図ととocamlの解釈には乖離が有るんで、 haskellとocamlの両刀使いさんの書かれた戒めを心に刻んでおこう。

次のBUGは新種かな？

   :
18724: [12]
18726: [18470; 12]
18727: [-1; 12]
5436: [-1; 12]
5437: [18727; -1; 12]
   :
1753: [-1; 12]
1754: [-2; 12]
1755: [12]
-1: [12]
Exception: Invalid_argument "index out of bounds".
[sakae@pcbsd ~/src/ml]$ ocaml z.ml | wc -l
Exception: Invalid_argument "index out of bounds".
     130

130歩目で、BUGに出会ったな。雰囲気からすると、過去の過ちが後になって露見したっぽいな。ロジアナを取り出して、100サイクルから130サイクルぐらいまでをモニター画面に出してみよう。

[sakae@pcbsd ~/src/ml]$ cat -n Hist.log | head -130 | tail -30
    :
   104  18724:  lit     [12,]  [2819,7565,7693,9656,]
   105  18726:  fetch   [18470,12,]  [2819,7565,7693,9656,]
   106  18727:  5434    [-1,12,]  [2819,7565,7693,9656,]
   107  5436:   pop     [-1,12,]  [18727,2819,7565,7693,9656,]
   108  5437:   542     [18727,-1,12,]  [2819,7565,7693,9656,]
     :
   126  5619:   1751    [18729,12,]  [18734,2819,7565,7693,9656,]
   127  1753:   dec     [18729,12,]  [5619,18734,2819,7565,7693,9656,]
   128  1754:   push    [18728,12,]  [5619,18734,2819,7565,7693,9656,]
   129  1755:   rtn     [12,]  [18728,5619,18734,2819,7565,7693,9656,]

何だか違いが発生した所がわかり辛いので、必要な部分を切り取ってきて、上下に並べてみた。（ocamlの結果をbad.logとして、桁合わせ、期待値をref.logとする）

[sakae@pcbsd ~/src/ml]$ cat bad.log ref.log | sort
   101  1560:           [0; 2548; 12
   101  1560:   swap    [0,2548,12,]  [18723,2819,7565,7693,9656,]
   102  1561:           [0; 2548; 12]
   102  1561:   store   [2548,0,12,]  [18723,2819,7565,7693,9656,]

旨くswapが実行出来ていないな。

let dyadic2 fn = let x, y = fn (pop ()) (pop ()) in push x; push y ;;
 :
  | 4 -> dyadic2 (fun x y -> y, x)   (* swap *)

swapは、内部関数のdyadic2を呼んでるんだけど、pop () の評価順がF#とは逆になってるようなので、pushの順番を(F#とは)逆にした。一生に一度ぐらいしか、dyadic2なんて参照しないんでもう忘れる事にしよう。本当は、未来の誰かの為に、コメントを残しておくべきだろうけど。。。

次は、ちょっと先へすすんでサイクル259で止まっているけど、これも過去の過ちがここで暴露されたってパターンみたい。こんなBugがC言語なんかで発生したら、どうやって追い詰めて行くんでしょうね？幸い今回はレコーダーが甘美（なかなかの誤変換）されてるんで、もぐら叩きみたいに気楽ですけど。

   136  1804:           [82;13]
   136  1804:   rtn     [82,13,]  [18678,18729,5619,18734,2819,7565,7693,9656,]
   137  18679:          [82;13]
   137  18679:  z_rtn   [82,13,]  [18729,5619,18734,2819,7565,7693,9656,]
   138  18680:  dup     [82,13,]  [18729,5619,18734,2819,7565,7693,9656,]
   138  18730:          [82;13]

どうやらz_retが旨く行ってない風。初期のコードは

  | 25 -> if tos () = 0 then drop (); ip := popr ()   (* z_ret *)

ifが成立した時、popr () は実行されるべきか？まあ、vmの命令自体がretってなってるんで実行されるべきだよな。じゃ、成立しない時は？うーーーん、無視しなきゃ虫だよね。って事で、then以下の２つの式を、括弧でくるんで、複合命令化したよ。

今度は、ちゃんと走るかな？

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

ok  bye

起動したら、だんまりを決め込まれてしまった。ちゃんと文句を言う大阪人みたいな人の方が扱い易いんですけど。だんまりはネェー。しょうがないので、byeって入れたら、つらつらと応答してきたぞ。さよならした後、こっそり文句を言うなんて根暗だなあ。こういう輩には、一文字づつflushするように、教育してあげたよ。

長くなったので、今日はここまで。Bug取りには、冴えた頭が必要です。徹夜して仕事が進んだ事なんて全くありませんでした。さっさと帰って、風呂でも入って、翌朝再チャレンジしたら、悩んでいたのが３分で解決した、なんて経験がざらにありましたよ。