Inside newLISP (5)

『コンピューターがネットと出会ったら』(角川学芸出版)なんて本を読んだ。坂村健先生が 監修なさった本。坂村先生ったら、あのTRONの提唱者だ。

当時、アメリカはこのOSに脅威を感じ、さかんに潰しにかかってきていた。そう、やつらは 知っていた。パソコン用のOSなんかはM$に任せておけば安泰だけど、遠い将来に、溢れるコンピュータは 色々な物に組み込まれるに違いない。そのOSを日本に押さえられるのは、非常な脅威になると。

今や、世に存在するコンピュータの90%は、いろいろな物（車、家電等々）に組み込まれている。 それがネットに繋がるようになったらどうよ？

記憶に新しい事として、2011年の地震の時、HONDAがカーナビの情報から通行出来た道路を 収集、それをググルと協力して通行可の道路MAPとして公開した。普段ならこういう事は、 プライバシー権を楯に許される事じゃなかったろうけど、非常時と言う事で、非常な快挙 だったのではなかろうか。激同意。

IoTって言葉が持て囃されている。IT業界のバズワードかと思うと、さにあらず。語源は 昔、P&G（迷惑な香料入り洗剤を作っている所。 臭い公害は田舎の香水で充分） の流通管理革新に重役会議が有った時に、招かれた教授が、重役連中にも分かるように 、物がインターネットに繋がれば、便利ですよと説明したのに端を発しているとか。

そう、RFIDで流通革命しましょってやつね。みんな管理されてるよね。スイカとかパスポートとか 運転免許証とかで。そして、データは誰の物てんで、JRが日立だかにスイカのデータを売っちゃったもの だから、高木先生とかが吼えたのは、記憶に新しい。

技術の問題よりも制度の問題が非常に大きくて、進歩が停滞してるってのが有るんだけど、 それを慣らそうってんで、物に番号を振る事になれるように盛んにコマーシャルしてるね。 そう、国民一人一人に番号を振っちゃえってやつ。来年からスタートするのかな。そのうちに、 希望者はRFIDを埋め込んであげますよ。そうすれば、パスポートを忘れて空港でおろおろする 事も無いし、免許不携帯で罰金取られる事も無くなりますよ、とな。近未来に実験が始まるだろう。

で、人に番号を振るだけじゃなくて、あらゆる物や場所にも番号を振っちゃえってのを 坂村先生は唱えていて、国際的に承認された。 ucodeとはとか、 ITproまとめucodeが詳しい。

で、問題になるのが、Last one hop 物とネットの接点ね。無線でやるか光でやるか、 今のIPv4じゃ無理、だったら、IPv6だな。電気喰わない簡易なやつね。

という事で、これまた先生が、6LowPANってのを提唱。RFCにして、これどうよ？って 投げている。

[sakae@fb10 ~]$ rfc -l 6282
   :
Abstract

   This document updates RFC 4944, "Transmission of IPv6 Packets over
   IEEE 802.15.4 Networks".  This document specifies an IPv6 header
   compression format for IPv6 packet delivery in Low Power Wireless
   Personal Area Networks (6LoWPANs).  The compression format relies on
   shared context to allow compression of arbitrary prefixes.  How the
   information is maintained in that shared context is out of scope.
   This document specifies compression of multicast addresses and a
   framework for compressing next headers.  UDP header compression is
   specified within this framework.

そして、通信プロトコルはやっぱりみんなが慣れてるhttpでしょ。でも、重くてね。 だったら軽いの考えようぜ。 CoAP( Constrained Application Protocol)とは 。これもRFC7252で、世に問われています、ってさ。

現在は、やれクラウドだ機械学習だとやたら、コンピューターパワーの部分が進化してる けど、入り口と出口の部分はこれからってのを強く認識した次第。

そう、Lisp屋ならずとも、read eval printと３拍子揃って初めて実用になるんよ。 そして、境界面をオープンにしておかないと、拡がらないのも道理。よく分かりましたよ。

最後に、組み込みOSの50%を押さえていると豪語してる TRONプロジェクト を挙げておく。いろいろな所に飛べて便利だよ。

primes

前回、rubyとcrystalで素数を求める勝負をしてみた。折角なので、newLISPも参戦させてみる。 今回 arrayとやらを使ってみる。

listとほぼ同じように使えるんだけど、全く同一に扱えるかと言うと微妙に違っていたりする。 例えば、dolistが使えないとか。どうしても使いたかったら、array-listでlistに変換するとかしないと だめだ。

それから、arrayで宣言した時、nilで初期化される。よって、rubyのコードは正論理で書いて あるけど、newlispでは、それをそのまま生かすべく、負論理で勝負してみた。

篩の部分は、取ってつけたようにdefineで囲ってあるけど、これはdebugする時、引数に 関数を渡す約束になってたから、そうしたまでで、特に意味は無い。

(setq N 100000000)
(setq sieve (array (+ N 1)))
(setf (sieve 0) true)
(setf (sieve 1) true)

(define (hoge)
(setq i 2 to (sqrt N))
(while (<= i to)
  (unless (sieve i)
    (setq j (* i i))
    (while (<= j N)
      (setf (sieve j) true)
      (inc j i)))
  (inc i)))

(hoge)
(setq i 0)
(while (< i N)
  (unless (sieve i)
    (println i))
  (inc i))
(exit)

実行してみると

sakae@uB:~/z$ time newlisp primes.lsp >/dev/null
Killed

real    0m24.307s
user    0m0.560s
sys     0m5.060s

OSによってメモリー喰いの迷惑千万なプロセスは殺されたんだな。 考えてみれば、１セルで20バイト消費するんだった。それを100M個も要求してるんで、 メモリーに載せようとすると、2Gも必要になる。今も昔もLispはメモリー大食い！

検索範囲を1/10の10Mまでに縮小して実行すると

sakae@uB:~/z$ time newlisp primes.lsp > /dev/null

real    0m19.073s
user    0m15.808s
sys     0m3.072s

こうなると、shiroさんコンピュータ搭載のgaucheではどうなん？って疑問が、ふつふつと 湧いてきます。上のコードをgosh用に書き換えて、実測。

(define N 10000000)
(define sieve (make-vector (+ N 1) #f))
(vector-set! sieve 0 #t)
(vector-set! sieve 1 #t)

(define (primes)
  (define i 2) (define to (sqrt N)) (define j 0)
  (while (<= i to)
         (unless (vector-ref sieve i)
                 (set! j (* i i))
                 (while (<= j N)
                        (vector-set! sieve j #t)
                        (inc! j i)))
         (inc! i)))

(primes)
(define i 0)
(while (< i N)
    (unless (vector-ref sieve i)
          (print i))
      (inc! i))
(exit)

まあ、コードは似たようなものだな。

sakae@uB:~/z$ time gosh 4gosh.scm > /dev/null
real    0m4.445s
user    0m4.328s
sys     0m0.112s
sakae@uB:~/z$ crystal build sieve.cr
Using compiled compiler at .build/crystal
sakae@uB:~/z$ time ./sieve > /dev/null
real    0m2.304s
user    0m2.004s
sys     0m0.296s
sakae@uB:~/z$ time ruby sieve.cr > /dev/null
real    0m12.917s
user    0m12.584s
sys     0m0.260s

gosh速えぇーーー。

Killed

OpenBSDで上記のメモリー喰いプログラムを実行しTopで監視すると、

load averages:  1.33,  0.49,  0.21                         ob.ring.net 06:16:39
18 processes: 1 running, 16 idle, 1 on processor
CPU states:  0.2% user,  0.0% nice, 99.8% system,  0.0% interrupt,  0.0% idle
Memory: Real: 143M/238M act/tot Free: 2684K Cache: 12M Swap: 259M/259M

  PID USERNAME PRI NICE  SIZE   RES STATE     WAIT      TIME    CPU COMMAND
 4639 sakae     35    0  754M   57M run       -         0:05 10.69% newlisp-10.
  :

swapを使い果たすのはいいんだけど、OSが暴走する。メモリーを要求した時に、もうあげないって 言われないのかな。言われたらメモリーを使い果たしたエラーを出して、newLISPが自殺する と思うんだけど、そんな素振りも無い。OSはけなげにメモリーを割り当てようとして、よからぬ 事が起きてしまったんだろうな。これの防止って、ulimitで制限をきつくする事なのかな？

しょうがないので舞台をFreeBSDに移してやってみる

[sakae@fb10 ~/t]$ newlisp primes.lsp
Killed
[sakae@fb10 ~/t]$ echo $?
137

何やら、エラー番号が返ってきたけど、なんじゃらホイ。確かこの番号は128げたを履いているんだった。 細かい事は、wait()なりwaitpid()で子プロセスの返すstatusを得られるから、それをミレ。

[sakae@fb10 ~]$ kill -l 137
KILL

って、まんまの案内じゃん。

こういう時は/var/log/messagesに 何か出てないか調べてみるんだな。最近、このファイルを覗く事なんて無いから、すっかり 忘れていたよ。

Sep  3 07:44:28 fb10 kernel: swap_pager: out of swap space
Sep  3 07:44:28 fb10 kernel: swap_pager_getswapspace(16): failed
Sep  3 07:44:29 fb10 kernel: pid 712 (newlisp-10.6.2), uid 1001, was killed: out of swap space

なる程、swapエリアの不足で、OSから刺客が送られて、殺されたんか。それにしても、この 情報はshellに伝わらないのかな。やけにあっさりしたメッセージしか表示しないな。

折角なんで、上記メッセージを出してる所を特定してみるか。

[sakae@fb10 /sys]$ find . -name '*.[ch]' -exec fgrep 'out of swap space' -H {} \;
./vm/swap_pager.c: *    about to run out of swap space, using lowat/hiwat hysteresis.
./vm/swap_pager.c:                      printf("swap_pager: out of swap space\n");
./vm/vm_pageout.c:              killproc(bigproc, "out of swap space");

いえねぇ、上記の検索技、最近覚えたので使ってみたかっただけかも。findで探しあてたファイルを execでfgrepに繋ぐ。ファイル名は －H の後ろにあるへんてこりんな文字の組み合わせ。 ーHは、ファイル名を表示せよ、だな。これを知る前は、バッククォートでファイルを集めて いたんだけど、しばしば引数が長すぎるぜエラーを喰らっていたんだ。

[ob: sys]$ find . -name \*.[ch] | xargs grep 'main('

こちらの方が、もっと簡単でっせ、と、天から慶事です。

killprocってぴったりなやつが有った。それは、kern/kern_sig.cに定義されてた。

killproc(p, why)
        struct proc *p;
        char *why;
{

        PROC_LOCK_ASSERT(p, MA_OWNED);
        CTR3(KTR_PROC, "killproc: proc %p (pid %d, %s)", p, p->p_pid,
            p->p_comm);
        log(LOG_ERR, "pid %d (%s), uid %d, was killed: %s\n", p->p_pid,
            p->p_comm, p->p_ucred ? p->p_ucred->cr_uid : -1, why);
        p->p_flag |= P_WKILLED;
        kern_psignal(p, SIGKILL);
}

/var/log/messagesに出すログは、ここで生成してるとな。所で、Killを受け取ったプロセスは 強制終了するって事だけど、どうやって実行されるんだろう？

unixカーネルの設計本をちょっと紐解いてみる。1999年の8月に買った本。あの頃はunixの 事良く分からなかったけど、今になって再読したら分かるかなあ？

関係のありそうな所を拾い読み。7.3 プロセスの終了の所

プロセスはexitシステムコールに実行する事によって終了する。exitで終了したプロセスは、 ゾンビ状態に入り、使用していた資源を解放する。構文は、exit(status)

処理方法を指定しないシグナルを受け取った場合、カーネルは内部的にexitを呼び出す。その 場合statusの値はシグナル番号になる。

本棚を覗いた時、1990年に買った、MINIXオペレーティングシステムなんて本も目に入ってきた。 タンネンバウム教授の教育用OSの解説本だ。リナス君がこれで勉強して、効率悪いじゃんって 教授と喧嘩し、だったら自前のOS作ってやるわいってんでLinuxが生まれたのは余りに有名。

ソースリストが本に載ってるんだけど、ちと追うのが大変だな。どこかにソースないかしら ってんで探してみたら、 パッケージ MINIX and Bochs (全てのリリース) で、公開してた。MINIXはLinuxの一枚板とは違って、Plan9風にモジュール構造になってるけど、 それぞれの部分は、大いに参考になるだろう。

もう一冊有った。Lions' Commentary on UNIX 6thEdition オイラーも昔、 unix/v6ってんでやってたね。

大分、脱線しちゃったんで、newLISPに戻ろう。

array

rubyのそれをnewLISPに移植する時、arrayが使われていたんで、newLISPにもarrayが あるかと探したらあったんでそのまま使った。もし無かったら、アレーと叫んでいた事で しょう。何てったって、途中のアクセスがO(1)で出来る。書き換えも同様。

listだとそうはいかずにアクセスはO(n)になるし、書き換えはlistのコピーが伴うので とんでもない事になる。綺麗な事では右に出るものがないHaskellでさえ、背に腹は変えられずに アレーを、アレーと言う程サポートしてますからね。

> (array 3)
(nil nil nil)
> (array 3 2 '(true 1 "hoge"))
((true 1) ("hoge" true) (1 "hoge"))

基本は、サイズを与えると、nilで初期化されたのが返る。初期値を与えたい時は、最後に指示する。 同一のtypeじゃなくても、文句言われない所が偉いぞ。ってか、包容力が大き過ぎる気が しないでもないですが。。。

コードを追うと、arrayはlistの仲間だって事で、nl-list.cの中のp_arrayに飛んでくる。

1663=>  array = makeArray(index, 0);
1664
1665    if (list != nilCell)
1666        array = initArray(array, list, &next);
1667
1668    return (array);

コードの前半部分は、引数の処理。indexと言う17要素の配列に、ディメンジョンのサイズが セットされる。listは初期化の値だ。

(array 10)ってのを評価した時、index配列は

(gdb) p index
$7 = {10, 0, -2065313788, ...]

２次元以降は無いので、0で終端してる。まるで、C語の文字列みたいな扱い。 makeArrayの第二引数は、ディメンジョン番号（最初はゼロ）を与えている。 ディメンジョン番号を増やしながら、再帰呼び出しするんで、わざわざ番号を渡してる。 初期値は、nilで埋められて、ディメンジョン番号が0以外の時は、copyCellしてる。

1665行のifは、初期値が有る場合の上書きだ。よって、なるべくなら、初期値を与えない方が、 スピードアップに寄与すると思われ。 おいらの野生の感も冴えてるね。

> (time (array 10000))
0.503000
> (time (array 10000 '(1 2 3 4 5 6 7)))
1.076000

大きなarrayを作る時は、アレーって程、効いてくるぞ。以上検証終わり。

makeArrayの中では何をやっているかと言うと

1680=>  array = getCell(CELL_ARRAY);
1681    size = index[p];
1682    array->contents = (UINT) callocMemory(size * sizeof (UINT) + 1);
1683    array->aux = size * sizeof (UINT) + 1;
1684    addr = (CELL * *) array->contents;
1685
1686    p++;
1687    if (index[p] > 0) {
  :
1693    } else
1694=>      while (size--)
1695            *(addr++) = copyCell(nilCell);
1696
1697    return (array);

エレメントの個数分+1の連続領域を取ってきて、その領域の先頭を保存後、nilCell（のアドレス）を 書き込んでいる。

次は、アレーの特定なindexを書き換える。p_setfの役目だ。（内部的にはsetqも同じルーチンを使う) p_setfの冒頭付近にある、evaluateExpressionで、対象になるアドレスを割り出す。

1554            /* implicit indexing array */
1555            else if (pCell->type == CELL_ARRAY) {
1556                if (!sPtr)
1557                    sPtr = symbolCheck;
1558=>              result = implicitIndexArray(pCell, args->next);
1559                symbolCheck = sPtr;
1560                pushResultFlag = FALSE;
1561            }

上記のimplicitIndexArrayが呼ばれて

1996    while (cell->type == CELL_ARRAY) {
1997        addr = (CELL * *) cell->contents;
1998        size = (cell->aux - 1) / sizeof (UINT);
1999        if (index < 0)
2000            index = index + size;
2001        if (index >= size || index < 0)
2002            return (errorProcExt2(ERR_ARRAY_INDEX_OUTOF_BOUNDS, stuffInteger(index))) ;
2003=>      cell = *(addr + index);
2004        if (params == nilCell || cell->type != CELL_ARRAY)
2005            break;
2006        params = getIntegerExt(params, (UINT *) & index, evalFlag);

対象のなるcell（アドレス）が取り出される。後は、このアドレスの内容を破棄し、 新しい値で置き換える。返値として、新しい値を返す。

GambitC

ふとOpenBSDにgambitC schemeが入っている事を思い出した。scheme語そのままでも 走るし、スクリプトをコンパイルしておいて走らせる事も出来る。crystalの先輩格だね。 登場して貰おう。

思い出したよ。バイナリーの作り方。そのままgsiで実行も出来る。

[ob: t]$ gsc -o run -exe 2gsi.scm

走らせてみると、余り大きな数だとヴェクターが溢れちゃうみたいで駄目。

[ob: t]$ time gsi 2gsi.scm > z
*** ERROR IN ##make-vector -- Heap overflow
    0m0.09s real     0m0.02s user     0m0.05s system
[ob: t]$ time ./run > z
    0m0.84s real     0m0.46s user     0m0.38s system
[ob: t]$ time gsi 2gsi.scm > z
    0m8.82s real     0m7.18s user     0m1.63s system

また、/dev/nullに棄てるのはOpenBSDでは駄目だったので、ファイルに落としてる。 ウブでは、そんな事無かったので、OpenBSDとの相性なんですかね。

使ったスクリプトは下記。gambitに無い手続きを、追加してる。inc!の増分値無しも 定義したかったんだけど、方法が分からなかったので、ちょっとみっともない事に なってる。

(define-macro (inc! var n)
      `(set! ,var (+ ,var ,n)))

(define-macro (unless test . body)
            `(if ,test #f (begin ,@body)))

(define-macro (while test . body)
  `(do ()
     ((not ,test))
     ,@body))

(define N 2000000)
(define sieve (make-vector (+ N 1) #f))
(vector-set! sieve 0 #t)
(vector-set! sieve 1 #t)

(define (primes)
  (define i 2) (define to (sqrt N)) (define j 0)
  (while (<= i to)
         (unless (vector-ref sieve i)
                 (set! j (* i i))
                 (while (<= j N)
                        (vector-set! sieve j #t)
                        (inc! j i)))
         (inc! i 1)))

(primes)
(define i 0)
(while (< i N)
    (unless (vector-ref sieve i)
          (print i "\n"))
      (inc! i 1))
(exit)