flisp, Stack Machine

VMってバーチャル・マシン、反対語はリアル・マシン。リアル・マシンって言い方は 余り聞かないけどね。

オイラーが何故VMに引かれるか？ それはリアル・マシンへの反動があるから。糞石を 使ったパソコンは論外。だったら、500円で買えるというラズパイか？

ラズパイの石はARMだ。結構複雑。だったら、自分で半田コテを握って、エッチラ・オッチラと 石を組み立てたらどうだ。昔、TTLを組み合わせて自分流CPUを作る本が出てたな。 感化されたあの人が、暫くRuby界で話題になってた。

もし自分CPUを組むなら、i4004 世界初のワンチップマイコンに敬意を払って、4Bitマシン ですかね。そいつを使って、電卓を作るのさ。

ALUはどうする？ ゲートを組み合わせてフルアダーとかを作るのは、かったるいな。 1970年代の記憶では、SN74181だったかの4Bit ALU が持て囃されていた。今でも 手に入りますか？ ＞テキサス・インスツルメント殿。

きっと、フルピッチのDIP品は全て廃番になりましたって言われるだろうね。その代わり、 ハーフピッチのものなら、１０万個単位で注文生産可能です、とか言ってくるかしら？

結局SN7400とかのゲートを組み合わせてALUを作る事になりそう。図面を引く前に、 論理の組み合わせを考え、ド・モルガンの定理をフル活用して、ハードのリファクタリング が必要だろうね。ゲート数をいかにケチるかが、ハード屋さんの腕の見せ所でしたから。

全体は、５相クロックぐらいの同期式かな。最初は緩く、サイクルタイムを500NSぐらい にしておき、後は、オーバークロックしてけばいいか。そうすると、プログラマブルな 発信器が必要になるな。それには、昔培ったVFOの技術が役立つだろう。夢想するのは 楽しい。

但し、実際にハードに触るようになると、 真剣勝負ですよ。逆配線とかしちゃうと、平気で煙が出たり、火を噴いたりする。 ICのチップがパンと小気味良い音を立てて割れたり、その破片が飛んできたり。後に 残るはいつまでも消えない、焼けたレジンの臭い。

コンデンサの逆配は、もう笑うしかない。ぱーとアルミ片が飛び散って、生臭い臭いが 充満しますから、即窓を全開にして、ありったけのファンを回し。。。。

そういう事からすると、パソコンの中に住まうバーチャル・マシンは、なんとも緩い やつだ。せいぜい暴走したって、外側のOSがブロックしてくれるし、楽でいいわい。 それに費用も今時嬉しい、０円ですから。

flisp builtins

flisp付属のsystem.lspをzappingしている。flispは組み込み用を狙ったみたいで、核に なる部分をC語で書き、それ以外をLisp語と言うかSchene語で書きましょって方針の ようだ。 そして、Scheme語で書いたものは、コンパイルして、flispとは別のflisp.bootに収めて おきましょ。こうすれば拡張は自在。よって、flispを動かすには、flisp.bootが必須に なる。もし、flisp.bootが無いと、

$ ./flisp
fatal error:
(io-error "file: could not open \"/usr/home/sakae/flisp.boot\"")

こんな具合に、実行を拒否される。まあ、それはそういうものとして、juliaの場合は どうしてる？ flisp.bootにjyulia語のコンパイラーを追加し、それを、16進で文字列 に変換し、文字列の配列としてflispの為のC語に取り込んでいるのだった。

ああ、flispを単体で使うとreplに編集機能が無いのでちと不満。

$ rlwrap ./flisp
;  _
; |_ _ _ |_ _ |  . _ _
; | (-||||_(_)|__|_)|_)
;-------------------|----------------------------------------------------------

> (time.now)
1459637339.0704059600830078

rlwrapで包んで起動すると、行編集や実行履歴検索した上での再実行が出来て便利。

で、time.nowなんてのを発掘した。これ単体ではほとんど使い道が無い。どこで 有効活用されるかと言うと、

(define-macro (time expr)
  (let ((t0 (gensym)))
    `(let ((,t0 (time.now)))
       (prog1
        ,expr
        (princ "Elapsed time: " (- (time.now) ,t0) " seconds\n")))))

ご存知のやつである。これを実現する為に、プリミティブとして、time.nowを実装して いるはず。builtins.cに

static value_t fl_time_now(value_t *args, u_int32_t nargs)
{
    argcount("time.now", nargs, 0);
    (void)args;
    return mk_double(clock_now());
}

clock_now()は、llt/timefuncs.cに細かい定義が有った。

double tv2float(struct timeval *tv)
{
    return (double)tv->tv_sec + (double)tv->tv_usec/1.0e6;
}

double clock_now()
{
#ifdef WIN32...
#else
    struct timeval now;

    gettimeofday(&now, NULL);
    return tv2float(&now);
#endif
}

先のtime.nowはとんでもない精度で表示されたけど、鵜呑みにしないでねってな事が 判明した。

(time (fib 38))

通過儀礼です。

> (define (fib n) (if (< n 3) n (+ (fib (- n 1)) (fib (- n 2)))))
#fn("9000r1|b3X640|;e0|ax31e0|b2x31w;" [fib] fib)

> (time (fib 38))
Elapsed time: 15.276824951171875 seconds
63245986

上記は、Makefileのデフォルト設定である、-DUSE_COMPUTED_GOTO を外しての実行結果。 下記の一例だけ、計算型gotoをイネーブルにしてみた。いにしえのFortran時代からの 知恵が生きていますなあ。

> (time (fib 38))
Elapsed time: 12.3614029884338379 seconds
63245986

ここからは、VMにgdbプローブを当てて観測し易いように、計算型gotoはOFFにして おきます。技術者の錬度を推測するには、オシロの使い方を見れば良いと、昔から 言われていますから。

goshでは、11秒弱でしたよ。それはさておき、flispには、(- n 1) の代わりに (1- n) を 使えるようになってたので、試してみます。

> (define (fib n) (if (< n 3) n (+ (fib (1- n)) (fib (- n 2)))))
#fn("9000r1|b3X640|;e0e1|3131e0|b2x31w;" [fib 1-] fib)

> (time (fib 38))
Elapsed time: 18.6516690254211426 seconds
63245986

反って遅くなりました。何故？ こういう時は、どんなコードを出しているか見るのが 正しい方法かな？

> (disassemble (define (fib n) (if (< n 3) n (+ (fib (- n 1)) (fib (- n 2))))))
maxstack 9
00000:  argc    1
00002:  loada0
00003:  loadi8  3
00005:  <
00006:  brf     @0000b
00009:  loada0
0000a:  ret
0000b:  loadg   fib
0000d:  loada0
0000e:  load1
0000f:  sub2
00010:  call    1
00012:  loadg   fib
00014:  loada0
00015:  loadi8  2
00017:  sub2
00018:  call    1
0001a:  add2
0001b:  ret

どう読むのかな？ 推測してみる。左側の数字は、命令の置かれているアドレスだろうね。 １から３バイトまでの可変長命令だな。

アーギュメントは１個。loada0は最初の引数をスタックへロードしなさい。loadi8は８ﾋﾞｯﾄ幅の 即値（３）をロードしなさい。

そして比較せい。結果がfalseなら、ｂ番地へ飛べ。loadgはグローバルfibの番地をロード しろ。load1は、プログラム中に頻出する即値である１をロードしろだな。そして引き算を 実行。

引数が１個だよとして、スタックに積んである(fib)を呼び出しって具合か。

> (disassemble (define (fib n) (if (< n 3) n (+ (fib (1- n)) (fib (- n 2))))))
maxstack 9
00000:  argc    1
00002:  loada0
00003:  loadi8  3
00005:  <
00006:  brf     @0000b
00009:  loada0
0000a:  ret
0000b:  loadg   fib
0000d:  loadg   1-
0000f:  loada0
00010:  call    1
00012:  call    1
00014:  loadg   fib
00016:  loada0
00017:  loadi8  2
00019:  sub2
0001a:  call    1
0001c:  add2
0001d:  ret

こちらは、先ほどよりも命令長が長い。1-を外部呼出ししてるんで、それのオーバーヘッドも 有って、遅いのだろうね。

それはそうと、勝手な推測の検証をしてみる。アーギュメントのロード命令が正しいかと言うのと、 引数の個数を持ってcallするという推測。

> (disassemble (define (hoge x y) (+ x y)))
maxstack 7
00000:  argc    2
00002:  loada0
00003:  loada1
00004:  add2
00005:  ret
 
> (disassemble (define (foo) (hoge x y)))
maxstack 8
00000:  argc    0
00002:  loadg   hoge
00004:  loadg   x
00006:  loadg   y
00008:  tcall   2
0000a:  ret

どうやら推測通りだ。

こういう、演算対象をstackに取るマシンを、そのままスタックマシンと言う。 どんな命令を備えるべき？ その備え度で、オレオレマシンがそれぞれ出来上がる。 大学の講義では、７B．スタックマシン なんてのが有ったぞ。

スタックマシンで有名なものに、 SECDマシン や pコードマシン とかForthが有る。Javaはもう知らない。

Forthと言えば、スレッデッドコード って、yarvな人が騒いでていたな。

compile

折角なのでcompile.lspを見ておく。コンパイラーなんだから、ソースのlisp語を マシン語(言うまでもないけどVMのね)に変換するのが目的。ならば、マシン語のニューモニックと相当するバイトコードが 有るはず。そして、バイトコードは、それを利用するVM側でも参照されるはず。

そういう観点で注意深く見ると、compiler.lspの冒頭に有るInstructionsがニューモニックと バイトコードの対応を保持している。

(define Instructions
  (let ((e (table))
        (keys
         [nop dup pop call tcall jmp brf brt jmp.l brf.l brt.l ret

          eq? eqv? equal? atom? not null? boolean? symbol?
          number? bound? pair? builtin? vector? fixnum? function?
               :
          dummy_t dummy_f dummy_nil]))
    (for 0 (1- (length keys))
         (lambda (i)
           (put! e (aref keys i) i)))))

やっている事は、辞書eを用意。ニューモニックのベクターkeysを用意。for関数で、 順番にベクターをアクセスしながら、ニューモニックを辞書のキーにして、ベクター 番号（これがバイトコードになる）を登録してる。

注: 上記で辞書の事を最初はhashって表現したんだけど、flispではhashを辞書とは(余り) 関係無い関数として登録してある。後で、hashを試してみれ。

> (get Instructions 'nop)
0

> (get Instructions 'cons)
27

そして、何時でもreplから対応を確認出来る。逆に、コードからニューモニックを 欲しければ

(define b2n (table.invert Instructions))

> (get b2n 27)
cons

キーとバリューをひっくり返したテーブルb2nを作っておいて、同様にその表を引いて あげれば良い。

ニューモニックの中はVMのためのアセンブラ名なんだけど、consとか一部がユーザーでも よく使うため、同名になっている。それらは、アリティが正しい事を要求される為、 コンパイラーの中に表を持っている。

(define arg-counts
  (table eq?      2      eqv?     2
         equal?   2      atom?    1
         not      1      null?    1
         boolean? 1      symbol?  1
         number?  1      bound?   1
         pair?    1      builtin? 1
         vector?  1      fixnum?  1
         cons     2      car      1
         cdr      1      set-car! 2
         set-cdr! 2      =        2
         <        2      compare  2
         aref     2      aset!    3
         div0     2))

今、VMの命令が幾つあるか調べたら、94個だった。まだまだ追加の余地は有るぞ。 なお、lisp側と言うかC語で書かれたVM用には、opcodes.hってのが使われている。 0から始まるenumが並んでいるだけだけどね。

コンパイラーの核の部分は、compile-f- のようだ。この最後の部分

          ; compile body and return
          (compile-in g (cons vars env) #t (lam:body f))
          (emit g 'ret)
          (values (function (encode-byte-code (bcode:code g))
                            (const-to-idx-vec g) name)
                  (aref g 3)))))))

bodyをコンパイルしてretを置いて、出来上がった成果を多値にして返してる。 細かい部分のコンパイルは、compile-in で振り分けされて下請け関数が呼び出されている。 なお、各関数の引数ｇは、結果をemitする為のportを持ち回る為、tail?は、末尾呼び出しへの 対応可能性フラグになる。

(define (expand-define x)
  (let ((form (cadr x))
        (body (if (pair? (cddr x))
                  (cddr x)
                  (if (symbol? (cadr x))
                      `(,(void))
                      (error "compile error: invalid syntax "
                             (print-to-string x))))))
    (if (symbol? form)
        `(set! ,form ,(car body))
        `(set! ,(car form)
               (lambda ,(cdr form) ,@body . ,(car form))))))

;;; in compile-in
         (case (car x)
            :
           (define   (compile-in g env tail?
                                 (expand-define x)))

一つ例を上げる。defineの解析。下請けのexpand-defineに回される。頭の部分formと 本体部bodyを取り出し、後は、頭がシンボルかどうかで場合分け。結果を更にしつこく 再分析。結果がどう展開されるか、確認してみる。

> (expand-define '(define hoge 123))
(set! hoge 123)

> (expand-define '(define (hoge x)(+ x x)))
(set! hoge (lambda (x)
             (+ x x) . hoge))

もう一つ if式の変換を見ておくかな。対応する下請けはcompile-if になる。得意のIT業界産業 構造がみてとれる。conpile-ifは、３次請けだな。ソースコードは、replから実行するには 適さないので、traceしてみます。

> (trace 'compile-if)
ok

> (disassemble (define (bar x y) (if (= x y) x y)))
(compile-if [(2 argc) #table() 0 +inf.0] ((x y) ()) #t  (if (= x y) x y))

maxstack 7
00000:  argc    2
00002:  loada0
00003:  loada1
00004:  =
00005:  brf     @0000a
00008:  loada0
00009:  ret
0000a:  loada1
0000b:  ret

conpile-ifの呼び出す部分は、下記の通り

(define (compile-if g env tail? x)
  (let ((elsel (make-label g))
        (endl  (make-label g))
        (test  (cadr x))
        (then  (caddr x))
        (else  (if (pair? (cdddr x))
                   (cadddr x)
                   (void))))

traceの結果のうち最初のベクターが ｇ に対応。次のリストはenvに対応。#tってscheme風なのが、tail? に 対応。そして最後のS式が、コンパイルしたい内容。

let中でtest式はcadr、thenはcaddr、else部は有るかどうかで、場合分け。じゃ、carを取ると 何か出て来る？ それは勿論、if ってのが出てくるけど、ここに至っては、そんなの 上位の関数で確認してるんで不要。なおelselとかは、ジャンプ先のラベルとして必要 なので、事前に作成してる。

このように、問題を小さくして行くと、行う事が明確になり、書き易い、読み易いコード が出来るんだな。（IT業界に取っては、仕事を発注し易い）

問題は、どう問題を分割して行くかが問題であります。（これぞ、再帰的 定義ですよ。）ITゼネコンの一次受けには、頭の切れる人が必要って訳だな。

trace

さらっとtraceなんてのを使ってしまったけど、どう動く？

> (define (hoge x) (* x x))
#fn("7000r1||T2;" [] hoge)

> (define (foo x y)(+ (hoge x) y))
#fn("7000r2e0|31}w;" [hoge] foo)

fooの中からhogeを呼び出す。簡単なやつ。hogeがどんな引数で呼ばれるか調べたかったら、 hogeをトレースする。

> (trace 'hoge)
ok

> (foo 3 1)
(hoge 3)
10

まあ、この例では余り有り難味がないけど、コンパイラー所の例だと、中くらいに嬉しいぞ。(By 一茶） もうトレースが不要ってなったら、untraceします。事前にtraceがイネーブルになってるか 確認しておいた方がよいかな

> (traced? hoge)
#t

> (traced? foo)
#f

> (untrace 'hoge)
newline

> (foo 3 1)
type error: apply: expected function, got newline
#0 (foo 3 1)

と、おかしな事が発生。どうやって調べてくれよう。先にtrace系のソースを見ておくか。

(define (trace sym)
  (let* ((func (top-level-value sym))
         (args (gensym)))
    (if (not (traced? func))
        (set-top-level-value! sym
                              (eval
                               `(lambda ,args
                                  (begin (write (cons ',sym ,args))
                                         (newline)
                                         (apply ',func ,args)))))))
  'ok)

(define (untrace sym)
  (let ((func (top-level-value sym)))
    (if (traced? func)
        (set-top-level-value! sym
                              (aref (function:vals func) 2)))))

マクロくずれが出てきて、脳味噌が沸騰しそうなので、現実に立ち返ってみます。

> (disassemble hoge)
maxstack 7
00000:  argc    1
00002:  loada0
00003:  loada0
00004:  *       2
00006:  ret

平凡なhogeが有ります。

> (trace 'hoge)
ok

> (disassemble hoge)
maxstack 10
00000:  vargc   0
00002:  loadv   #fn(write)
00004:  loadv   hoge
00006:  loada0
00007:  cons
00008:  call    1
0000a:  pop
0000b:  loadg   newline
0000d:  call    0
0000f:  pop
00010:  loadv
        maxstack 7
        00000:  argc    1
        00002:  loada0
        00003:  loada0
        00004:  *       2
        00006:  ret
00012:  loada0
00013:  tapply  2
00015:  ret

トレースを掛けると、何やら挟みこまれました。untraceのコードを抜き出してきて実験 。

> (function:vals hoge)
[#fn(write) hoge newline #fn("7000r1||T2;" [] hoge)]

どうやら、戻すエレメントを間違えているようです。untraceの最後の行にある２を３に 変更したら、正常動作しました。

ああ、正式な修正方法は、system.lspにあるuntrace部分を変更。次に、付属のbootstrap.shを 走らせて、再コンパイル、flisp.bootへの焼付けって手順になります。

C語で書かれたflispがVM（とcons領域を割り当てられたRAM）とすれば、flisp.bootは、VMの 実行コードが収納されたROMに相当します。ROMを焼くなんて、かの昔にH8内蔵のフラッシュを 相手にした以来で、懐かしいな。

juliaに内蔵のflispマシンの更新は、ちと面倒ですから、実施は見送る事にします。 （影では、バイナリーパッチで１箇所変更って言ってますけどね。。。）

でこの虫は、作者さんに SEND PRですかね。ああ、今風に言うと、pull request って言うんでしたっけ？ 若しオイラーの要求を受理してくれたら、juliaまで波及するかなあ？ juliaの隠れlispは、世に余り知られていないはずだから、無視を決め込む？ だったら、要求をパラレル・リクエストすれば良いのか。