Inside newLISP (3)

先月号のCQ誌は買ったけど、今月号はネットで内容を確認のみ。で、気になったのが“TRX-305”ってやつ。初めて聞く名前だな。フルデジタルのトランシーバーですって。

ぐぐってみると、トラ技スペシャルらしい。トラ技は常にモニターしてる訳ではないので、洩れてたんだな。

それにしても、トラ技が去年で創刊50年とは、素晴らしい記録ですな。輝かしい電子立国に発展に大いに寄与したってんで、国から表彰されても良いと思うぞ。

会社勤めしてる頃は、会社で取ってくれていたので毎号読んでいたけど、実践的な内容が多くて、専門書を補間するにはうってつけだった。そうそう、昔のインターフェースも面白かったな。今は記事が細切れ過ぎるように思う。

なにはともあれ、こういうおもちゃがあると、いろいろな人が飛びついている。

フルディジタルトランシーバ　TRX-305A　（2014.11.6）スペアナ持ってる人は無銭家とは言えんな。ましてや、このキットが10万円以上もするんだから。

DSP空挺団も触手を動かされてます。

AOR TRX-305プラモデルを組み立てる感覚だなあ。リグをパソコンからコントロールするってのは、もう当たり前な機能なんだな。

電子工作オタクのメモオイラーより１年先輩のページ。パワーが有りますなあ。仙台在住って事でパワーの源は、かき徳の牡蠣なんでしょうか。そろそろ牡蠣が美味しくなるな。

ＳＤＲ体験なにやら、簡単にSDRを体験出来そう。世の中進歩が速いなあ。

なんとなくクリスタル

以前見つけておいたhttp://crystal-lang.org/である。間違って田中康夫へ飛んでいかないように！

冗談はさておき、入れてみる。って、入れ方は、ドキュメントの頭の所に書いてある。例によってBSD系とWindows系は無視されてるんであしからず。オイラーは、なんとなくクリスタルモードなんで、ウブに突っ込んでみた。そしたら、何と/optなんてのを堀やがって、そこに鎮座した。開発者は新人類かMAC屋さん？

emacs用のクリスタルモードが有るかと思ったら、普通の所にはなくて、 Emacs で Crystal を書くがQiitaに上がっていた。メジャーになるのは何時だ。それまでは、生暖かく、、、、emacsに標準で入っている ruby-modeを使っておｋ。

サンプルで、赤黒木が有ったので、走らせてみる。

sakae@uB:~/z$ crystal red_black_tree.cr
/opt/crystal/bin/../embedded/lib/../lib/libunwind.a(Los-linux.o): In function `_ULx86_local_resume':
Los-linux.c:(.text+0x73b): warning: sigreturn is not implemented and will always fail
delete: 00:00:03.4539240, res: 0
add: 00:00:01.9207680, res: 100000
search: 00:00:01.3763080, res: [63178, 100000]
walk: 00:00:03.0119300, res: [100277, 100000]
reverse_walk: 00:00:03.0378360, res: [100277, 100000]
min: 00:00:09.1905040, res: 0
max: 00:00:09.6184000, res: 9999800000
summary time: 00:00:31.6782830

オイラーのウブでは、ちとご不満なようで。でも、走ってくれた。

次は、コンパイルしておいて実行

sakae@uB:~/z$ crystal build red_black_tree.cr
/opt/crystal/bin/../embedded/lib/../lib/libunwind.a(Los-linux.o): In function `_ULx86_local_resume':
Los-linux.c:(.text+0x73b): warning: sigreturn is not implemented and will always fail
sakae@uB:~/z$ ./red_black_tree
delete: 00:00:03.5843710, res: 0
add: 00:00:01.8124170, res: 100000
search: 00:00:01.2016790, res: [63508, 100000]
walk: 00:00:02.9265340, res: [99801, 100000]
reverse_walk: 00:00:02.8420790, res: [99801, 100000]
min: 00:00:08.3951490, res: 100000
max: 00:00:09.9405880, res: 9999700000
summary time: 00:00:30.7708040

コンパイル時間が無くなるので、多少早くなるね。

sakae@uB:~/z$ crystal types red_black_tree.cr
$inst : RedBlackTree::NilNode
t : Time
b : RedBlackTreeRunner

グローバル変数のチェック

sakae@uB:~/z$ crystal hierarchy red_black_tree.cr | col -bx

クラスのリスト。エスケープ文字が含まれているので、それを避けています。けど、sedを噛ませないとだめだな。噛ませると、落ち着いて見られるな。

  +- class Reference (4 bytes)
     |
     +- class RedBlackTreeRunner (20 bytes)
     |      @n    : Int32        (4 bytes)
     |      @a1   : Array(Int32) (4 bytes)
     |      @a2   : Array(Int32) (4 bytes)
     |      @tree : RedBlackTree (4 bytes)
     |
     +- class RedBlackTree (12 bytes)
     |      @root : RedBlackTree::Node+ (4 bytes)
     |      @size : Int32               (4 bytes)
     |
     +- class RedBlackTree::Node (24 bytes)
     |  .   @key    : Int32                       (4 bytes)
     |  .   @color  : Symbol                      (4 bytes)
     |  .   @parent : RedBlackTree::Node+         (4 bytes)
     |  .   @right  : (Nil | RedBlackTree::Node+) (4 bytes)
     |  .   @left   : (Nil | RedBlackTree::Node+) (4 bytes)
     |  |
     |  +- class RedBlackTree::NilNode (24 bytes)
     |
     +- class Random::MT19937 (2504 bytes)
     |      @mt  : StaticArray(UInt32, 624) (2496 bytes)
     |      @mti : Int32                    (   4 bytes)
     |
     +- class FileDescriptorIO (40 bytes)
     |      @edge_triggerable : Bool              (0 bytes)
     |      @flush_on_newline : Bool              (0 bytes)
     |      @sync             : Bool              (0 bytes)
     |      @closed           : Bool              (0 bytes)
     |      @fd               : Int32             (4 bytes)
     |      @in_buffer_rem    : Slice(UInt8)      (8 bytes)
     |      @out_count        : Int32             (4 bytes)
     |      @readers          : Array(Fiber)?     (4 bytes)
     |      @writers          : Array(Fiber)?     (4 bytes)
     |      @event            : LibEvent2::Event? (4 bytes)
     |      @out_buffer       : Pointer(UInt8)?   (4 bytes)

こんな物まで見せちゃって大丈夫？

rubyと競争してみる。お題は素数。例にあったやつ

max = 10_000_000

sieve = Array.new(max + 1, true)
sieve[0] = false
sieve[1] = false

2.step(Math.sqrt(max)) do |i|
  if sieve[i]
    (i * i).step(max, i) do |j|
      sieve[j] = false
    end
  end
end

sieve.each_with_index do |prime, number|
  if prime
    puts number
  end
end

sakae@uB:~/z$ time ruby sieve.cr > /dev/null

real    0m12.961s
user    0m12.764s
sys     0m0.184s
sakae@uB:~/z$ time crystal sieve.cr > /dev/null
/opt/crystal/bin/../embedded/lib/../lib/libunwind.a(Los-linux.o): In function `_ULx86_local_resume':
Los-linux.c:(.text+0x73b): warning: sigreturn is not implemented and will always fail

real    0m3.331s
user    0m2.212s
sys     0m0.900s
sakae@uB:~/z$ crystal build sieve.cr
/opt/crystal/bin/../embedded/lib/../lib/libunwind.a(Los-linux.o): In function `_ULx86_local_resume':
Los-linux.c:(.text+0x73b): warning: sigreturn is not implemented and will always fail
sakae@uB:~/z$ time ./sieve > /dev/null

real    0m2.251s
user    0m1.932s
sys     0m0.312s

コンパイルすると、5倍は速くなったな。後は、ライブラリィが既存のものをそのまま使えるかだな。言い換えると、rakeとか、gemが使えるか。当面レールが動けば、喜ぶ人が多数と思われ。みんなで支援してあげましょう。

で、Crystal で Ruby のコードってどんだけそのまま動くの？の苦労が無くなると嬉しいぞ、と。

で、aptで入れた奴はオイラーの所で文句垂れるんで、ソースから入れてみる。いきなりソースからってのは、例によって例のごとく、鶏卵問題に遭遇するんでだめです。種のcrystalを用意しましょう。

順調にいくかと思ったら、またリナの嫌がらせが有った。コンパイルが済んで、リンカーの段階で、leditが無いと言う。そして極めつけは、

sakae@uB:~/z$ crystal build sieve.cr
Using compiled compiler at .build/crystal
/usr/bin/ld: cannot find -levent
/usr/bin/ld: cannot find -lpcl
/usr/bin/ld: cannot find -lgc
collect2: error: ld returned 1 exit status
  :

全くもって、いろいろなものを要求され、疲れるわい。適当にらいぶらりを持ってきても、マッチングが取れていないようで、エラーですよ。

sakae@uB:~/z$ crystal build sieve.cr
Using compiled compiler at .build/crystal
/home/sakae/z/.crystal/home/sakae/z/sieve.cr/main.o: In function `__crystal_main':
main_module:(.text+0x5850): undefined reference to `GC_get_push_other_roots'
main_module:(.text+0x58c0): undefined reference to `GC_set_push_other_roots'
collect2: error: ld returned 1 exit status

しょうがないので、/opt/crystal/embedded/lib/libgc.a を、/usr/libに叩き込んであげたら、コンパイル成功。

sakae@uB:~/z$ crystal build sieve.cr
Using compiled compiler at .build/crystal
sakae@uB:~/z$ file sieve
sieve: ELF 32-bit LSB executable, Intel 80386, version 1 (SYSV), dynamically linked (uses shared libs), for GNU/Linux 2.6.32, BuildID[sha1]=c4bb2b6c2cc1a642cee6c03c1b014d1ca8272f1d, not stripped
sakae@uB:~/z$ ldd sieve
        linux-gate.so.1 =>  (0xb76fc000)
        libevent-2.0.so.5 => /usr/lib/i386-linux-gnu/libevent-2.0.so.5 (0xb768d000)
        libpcre.so.3 => /lib/i386-linux-gnu/libpcre.so.3 (0xb761b000)
        libpthread.so.0 => /lib/i386-linux-gnu/libpthread.so.0 (0xb75fd000)
        libunwind.so.8 => /usr/lib/i386-linux-gnu/libunwind.so.8 (0xb75e6000)
        libgcc_s.so.1 => /lib/i386-linux-gnu/libgcc_s.so.1 (0xb75c9000)
        libc.so.6 => /lib/i386-linux-gnu/libc.so.6 (0xb740e000)
        /lib/ld-linux.so.2 (0xb76fd000)
        liblzma.so.5 => /lib/i386-linux-gnu/liblzma.so.5 (0xb73e8000)
        libdl.so.2 => /lib/i386-linux-gnu/libdl.so.2 (0xb73e2000)

出来上がったバイナリーはstripしてなかったので、gdbにかけてみたら、

(gdb) bt
#0  0xb7fdbbe0 in __kernel_vsyscall ()
#1  0xb7eeb5d3 in __write_nocancel () at ../sysdeps/unix/syscall-template.S:81
#2  0x0805adf9 in *FileDescriptorIO#unbuffered_write<FileDescriptorIO, Slice(UInt8), Int32>:Int32 ()
#3  0x0805acb6 in *FileDescriptorIO@BufferedIOMixin#flush<FileDescriptorIO>:Int32 ()
#4  0x0805b630 in *FileDescriptorIO@BufferedIOMixin#write_byte<FileDescriptorIO, UInt8>:(Nil | Int32) ()
#5  0x0805b514 in *FileDescriptorIO@IO#puts<FileDescriptorIO>:(Nil | Int32) ()
#6  0x0805b781 in *FileDescriptorIO@IO#puts<FileDescriptorIO, Int32>:(Nil | Int32) ()
#7  0x08051593 in *puts<Int32>:(Nil | Int32) ()
#8  0x08050116 in __crystal_main ()
#9  0x080512ff in main ()
(gdb) f 8
#8  0x08050116 in __crystal_main ()
(gdb) l
1       ../sysdeps/i386/dl-procinfo.c: No such file or directory.
(gdb) f 9
#9  0x080512ff in main ()
(gdb) l
1       in ../sysdeps/i386/dl-procinfo.c

何やら、秘密めいたLinuxべったり感が漂ってますなあ。

evaluateExpression

回を重ねるInside newLISPもいよいよ核心に迫ってきた。今回は表題の部分。これは、evaluateStream から呼び出される。

主要部分は、大雑把にcellタイプによって場合分けしてる。

1472    switch (cell->type) {
1473    case CELL_QUOTE:
 :
1476    case CELL_EXPRESSION:
1477        args = (CELL *) cell->contents;
 :
1586    case CELL_DYN_SYMBOL:
 :
1590    default:
1591        result = nilCell;
1592    }

そして主要な部分は、1476行目から始まる部分だ。この中で、1477行でコンテンツを取り出し、更に場合分けしていく。

普通の関数（例えば、(dump and)みたいなやつ）の場合、シンボルになるんで、その内容を取り出す。そしてシンボルの内容を引き

1516        /* pCell is evaluated op element */
1517        if (pCell->type == CELL_PRIMITIVE) {
1518            evalFunc = (CELL * (*) (CELL *)) pCell->contents;
1519=>          result = evalFunc(args->next);
1520            evalFunc = NULL;
1521            break;

このあたりに落ちてくる。ここで、evalFuncの値は？と言うと

(gdb) p evalFunc
$1 = (CELL *(*)(CELL *)) 0x1bcf49a6 <p_dump>

見事にプリミティブな関数、p_dump が抽出された。後は、argsのcdrを引数にして、p_dumpへと飛んで行く事になる。

飛んで行った(p_dump)では、

7011=>  if (params != nilCell) {
7012        cell = evaluateExpression(params);
7013        return (stuffIntegerList
7014              (5, cell, cell->type, cell->next, cell->aux, cell->contents));
7015    }

cellがnilじゃ無い事を確かめて、引数を評価し（相互再帰してんな）、返ってきた値を、この場合は、数値のリストに変換して返している。

先ほどは、S式の第１項がプリミティブの場合だったけど、それ以外の場合もやはり、pCellのタグを見て場合分けしてる。こちらは、switchでの場合分けじゃなくてifのブロックになってる。

1517        if (pCell->type == CELL_PRIMITIVE) {
 :
1523        if (pCell->type == CELL_LAMBDA) {
 :
1529=>      if (pCell->type == CELL_FEXPR) {
 :
1537        if (pCell->type & IMPORT_MASK) {
 :
1542        /*
1543         * implicit indexing or resting for list, array or string
1544         */
1545        if (args->next != nilCell) {
 :

特徴的なのが、1543行目にコメントで示されているが、リストや文字列やアレーのインデックシングによる値の取り出し。これを実現したいばかりに、わざわざifのブロックで場合分けしてるのね。

それじゃ、代表的な例として、 (2 "ABCDEFGH") を追ってみる。

1574            /* implicit resting for lists and strings */
1575            else if (isNumber(pCell->type))
1576=>              result = implicitNrestSlice(pCell, args->next);

ここから、implicitNrestSliceが呼ばれる。

implicitNrestSlice (num=0x8314da90, params=0x8314da00) at newlisp.c:5242
5242    {
(gdb) p *num
$4 = {type = 898, next = 0x8314da00, aux = 2, contents = 0}
(gdb) p *params
$5 = {type = 260, next = 0x8314c000, aux = 9, contents = 2106858112}
(gdb) x/s 2106858112
0x7d941a80:     "ABCDEFGH"

paramesに渡した文字列の、２文字目以降を返せルーチンなんだな。追って行くと、

substring (string=0x7d941a80 "ABCDEFGH", slen=8, offset=2, len=2147483647) at nl-string.c:61

文字列をスライスして、律儀にそれをセルに詰め込んで、結果としてるね。

evaluateLambda

今度は、ユーザー定義の関数がどう実行されるか追ってみる。お題は

> (define (hoge n) (* n n))
(lambda (n) (* n n))
> (hoge 8)

こんな簡単なやつ。C側の関数で目星を付けた、evaluateLambdaにBPを置いたら、ヒットしたぞ。呼び出しは、

1523        if (pCell->type == CELL_LAMBDA) {
1524            pushLambda(args);
1525=>          result = evaluateLambda((CELL *) pCell->contents, args->next, newContext);
1526            --lambdaStackIdx;
1527            break;

newContextって何かと思えば

(gdb) p *newContext
$4 = {
  flags = 48,
  color = 0,
  name = 0x37d77edc "MAIN",
  contents = 2050551840,
  context = 0x86ab7240,
  parent = 0x80261720,
  left = 0x7d8e35e0,
  right = 0x80261880
}

MAINに定義したから、MAINで評価されるんだろうね。

1745                cell = result = copyCell(evaluateExpression(arg));
(gdb) p *arg
$5 = {
  type = 898,
  next = 0x7a38f000,
  aux = 8,
  contents = 0
}

引数を評価しておいて、1755行あたりで、現在のコンテキストを新しいコンテキストに切り替え、ローカルシンボルに引数を割り当てて1817行で、評価。結果は

(gdb) p *result
$11 = {
  type = 898,
  next = 0x7a38f000,
  aux = 64,
  contents = 0
}

こんな風に実行されるのね。で、先のnewContextの疑問、今度は、FUGAってcontextに切り替えてみた。そしたら、

Breakpoint 1, evaluateLambda (localLst=0x7a390c00, arg=0x7a390be0, newContext=0x84322000) at newlisp.c:1726
1726        CELL           *result = nilCell;
(gdb) p *newContext
$13 = {
  flags = 48,
  color = 1,
  name = 0x81881800 "FUGA",
  contents = 2050558464,
  context = 0x86ab7240,
  parent = 0x7d8e35c0,
  left = 0x37d7d2c0 <sentinel>,
  right = 0x37d7d2c0 <sentinel>
}

こんな具合に、新しいコンテキストと言うかモジュール環境に切り替わったね。予想通り！追うのは、これぐらいで良いかな。