親子丼(4)
人間の慣用句に『肩の荷が下りる』ってのがあるけど、りんごの樹の場合は『枝の荷が下りる』って 言います。
近くの山が白くなった今日この頃、林檎の樹がほのかに紅葉してる。紅葉って言っても紅くなる んじゃなくて黄色くなるんだけど、見方を変えれば枯葉に近くなるって事だ。
枝が折れんばかりになった林檎の樹より荷を降ろす作業が急ピッチで進められている。これで枝を 支えるつっかえ棒も不要になるな。近くの林檎集積場から、4トン車に満載になって旅立って 行ったよ。一箱幾らなんだろう？ 某地のブランド林檎は、28玉で110万円もしたそうだから、 結構高いのね。
幸いおいらの所では林檎を買わなくても済んでいる。ありがたいことです。地縁、血縁のなせる 幸福なんでしょうかね。
この間、食べ飽きて冷蔵庫に入れてあった林檎をすり潰してカレーに入れてくれた。秀樹の 林檎と蜂蜜カレーが頭にあったのかどうかは知らないが、これがすこぶる美味でした。 ほのかな酸っぱさと甘みが絶品でしたね。
今度は、りんごジュースにするのかな。鳥さんがデザートに食いちらかしたくず林檎が あるんよ。腐る前に何とか食べちゃわないとな。でも、こんな甘いものばかり食べていると 糖尿病になっちゃうかな。食後に食べると、口の中がさっぱりするんで止められないぞ。
別解
前回は、scmをCに変換し、gdbにかけてみたけど、核心に迫れなかった。別解を求めてみる。 あんちょこを利用します。globalしましょってね。で、どうせやるなら、ちょっと複雑な スキームをば。（ああ、スキームって書くと、どっかのかぶれた政治家みたいだな）
[sakae@cdr ~/t]$ cat -n t.scm
1 (use extras)
2
3 (define (me)
4 (+ (random 100) (random 100) (+ 123 (random 100))))
5
6 (me)
[sakae@cdr ~/t]$ make
chicken -to-stdout t.scm | indent > t.c
gcc -g -o me runtime.o library.o eval.o expand.o extras.o data-structures.o ports.o t.c -lm
[sakae@cdr ~/t]$ gtags
[sakae@cdr ~/t]$ htags -sanohITvt 'Welcome to CHICKEN'
[sakae@cdr ~/t]$ w3m HTML/index.html
GC Warning: Repeated allocation of very large block (appr. size 3690496):
May lead to memory leak and poor performance.
Last updated Wed Nov 23 10:51:06 JST 2011
出来たHTMLはとてつもなく大きなものでした。それをw3mで眺めてみたんですが、w3mが悲鳴を 上げていましたよ。
前回gdbでmainにbreakを置いたにもかかわらず別の場所でbreakした不思議な現象があった。 そのからくりはどうなってるかと思えば
1391 # define C_main_entry_point \
1392 int main(int argc, char *argv[]) \
1393 { \
1394 C_set_gui_mode; \
1395 C_private_repository(argv[ 0 ]); \
1396 return CHICKEN_main(argc, argv, (void*)C_toplevel); \
1397 } C_end_of_main
こんなのが、chicken.hに定義されてました。さすがLisperはマクロ大好き！ この定義のすぐ前に Windows用の定義が置いてあったんだけど、GUIでぐいぐい出来るような雰囲気だったよ。
それから、トランポリンは、このあたりかな
59 /* toplevel */
60 static C_TLS int toplevel_initialized = 0;
61 C_main_entry_point
62 C_noret_decl(toplevel_trampoline)
63 static void C_fcall toplevel_trampoline(void *dummy)
64 C_regparm C_noret;
65 C_regparm static void C_fcall toplevel_trampoline(void *dummy)
66 {
67 C_toplevel(2, C_SCHEME_UNDEFINED, C_restore);
68 }
これ、t.c内の定義。んでもって、肝心のC_toplevelはと言うと
94 C_initialize_lf(lf, 3);
95 lf[0] = C_h_intern(&lf[0], 2, "me");
96 lf[1] = C_h_intern(&lf[1], 6, "random");
97 lf[2] = C_h_intern(&lf[2], 25, "\003sysimplicit-exit-handler");
98 C_register_lf2(lf, 3, create_ptable());
99 t2 = (*a = C_CLOSURE_TYPE | 2, a[1] = (C_word) f_12, a[2] = t1, tmp
100 C_library_toplevel(2, C_SCHEME_UNDEFINED, t2);
101 }
102
103 /* k10 */
104 static void C_ccall
105 f_12(C_word c, C_word t0, C_word t1)
106 {
107 C_word tmp;
108 C_word t2;
109 C_word t3;
110 C_word ab [3], *a = ab;
111 C_check_for_interrupt;
112 if (!C_stack_probe(&a)) {
113 C_save_and_reclaim((void *)tr2, (void *)f_12, 2, t0, t1);
114 }
115 t2 = (*a = C_CLOSURE_TYPE | 2, a[1] = (C_word) f_15, a[2] = ((C_wor
116 C_eval_toplevel(2, C_SCHEME_UNDEFINED, t2);
なんだか、見慣れた名前、meとかrandomとかが出てきたな。想像するに、t.c側の実質的基点は、 f_12っぽいな。こいつを引数にして、ライブラリを呼び出すとな。そしてぐるっと回って また、t.cに戻ってくる予感。
f_12には、k10なんて言う意味不なコメントが付いてたので、探ってみる。
[sakae@cdr ~/t]$ grep k10 t.c /* k10 */ /* k13 in k10 */ /* k16 in k13 in k10 */ /* k41 in k16 in k13 in k10 */ /* k47 in k41 in k16 in k13 in k10 */ /* k44 in k41 in k16 in k13 in k10 */ /* me in k16 in k13 in k10 */ /* k26 in me in k16 in k13 in k10 */ /* k30 in k26 in me in k16 in k13 in k10 */ /* k38 in k30 in k26 in me in k16 in k13 in k10 */
何となく何となくって匂いがするな。
[sakae@cdr ~/t]$ gdb me
(gdb) b f_12
Breakpoint 1 at 0x81ef0a6: file t.c, line 110.
(gdb) run
Starting program: /usr/home/sakae/t/me
Breakpoint 1, f_12 (c=2, t0=675335948, t1=30) at t.c:110
110 C_word ab [3], *a = ab;
(gdb) bt
#0 f_12 (c=2, t0=675335948, t1=30) at t.c:110
#1 0x080b42c6 in f_21656 (c=Could not find the frame base for "f_21656".) at library.c:11791
#2 0x080f55d6 in f_11598 (c=Could not find the frame base for "f_11598".) at library.c:28392
#3 0x080f6479 in f_11460 (c=2, t0=-1077996252, t1=22) at library.c:28650
#4 0x080f5c43 in f_11520 (c=Could not find the frame base for "f_11520".) at library.c:28511
:
#415 0x08094343 in trf_11408 (dummy=Could not find the frame base for "trf_11408".) at library.c:6100
#416 0x0804b30c in CHICKEN_run (toplevel=0x0) at runtime.c:1324
#417 0x080496ba in CHICKEN_main (argc=1, argv=0xbfbfe758, toplevel=0x81eeed0) at runtime.c:540
#418 0x081eee8a in main (argc=134955152, argv=0xbfbf1d40) at t.c:61
随分豪快にスタックを使ってますなあ。これがトランポリンの威力です。よく跳ねる！
で、t.cのコードを眺めていて、trace用のコードが埋め込まれている事に気づいた。
[sakae@cdr ~/t]$ grep -n t.scm t.c
2: * Generated from t.scm by the CHICKEN compiler
5: * on cdr.kuma.net (FreeBSD) command line: -to-stdout t.scm used units:
150: C_trace("t.scm:6: me");
210: C_trace("t.scm:4: random");
227: C_trace("t.scm:4: random");
244: C_trace("t.scm:4: random");
261: C_trace("t.scm:4: +");
trace
そうか、traceって手もあるな。gdbでtraceってどうやるん？ そんな事おいらは知らないよ。 知ってるのは、Lispのそれだ。玉子のカタログを見てたら、traceってのが陳列されてたんで 入れてみたよ。
#;1> (use trace) ; loading /usr/local/lib/chicken/6/trace.import.so ... ; loading /usr/local/lib/chicken/6/advice.import.so ... ; loading /usr/local/lib/chicken/6/trace.so ... ; loading /usr/local/lib/chicken/6/advice.so ... #;2> (load "t.scm") ; loading t.scm ... #;3> (trace me + random) ; tracing me ; tracing C_plus ; tracing f_920 #;4> (me) [0] (me) [1] (f_920 100) [1] f_920 -> 22 [1] (f_920 100) [1] f_920 -> 48 [1] (f_920 100) [1] f_920 -> 60 [1] (C_plus 123 60) [1] C_plus -> 183 [1] (C_plus 22 48 183) [1] C_plus -> 253 [0] me -> 253 253
へぇ、csiって引数を左から右に評価するのね。SICPの問題集に、引数の評価順を調べるってのが 出てたと思ったけど、こういう調べ方でも良かったんですかね？
で、randomがf_920に対応してるって事でいいのかな？
#;5> random #<procedure (f_445 . args84)> #;6> + #<procedure (f_445 . args84)> #;7> (untrace me + random) ; untracing f_445 ; untracing f_445 ; untracing f_445 #;8> random #<procedure (f_920 n102)> #;9> + #<procedure C_plus> #;10> me #<procedure (me)> #;11> trace #<procedure (trace#trace . procs351)>
なる程、traceの入り口は一つなんだな（まあ、それは当たり前）、csiの手続き名は、Cの関数名 で登録されてるとな。そんじゃ、Cのソースになる前のschemeのコードを見る方が先だな。
(define (do-trace procs)
(for-each
(lambda (s)
(ensure procedure? s)
(cond ((assq s *traced-procedures*)
(warning "procedure already traced" s) )
(else
(let ((name (procedure-name s)))
(when (trace-verbose)
(fprintf (current-error-port) "; tracing ~a~%" name))
(set! *traced-procedures* (cons (cons s name) *traced-procedures*))
(advise
'around s
(lambda (next args)
(let ((results #f))
(dynamic-wind
(cut traced-procedure-entry name args)
(lambda ()
(call-with-values (cut apply next args)
(lambda rs
(set! results rs)
(apply values rs))))
(cut traced-procedure-exit name results))))
'*trace*)))))
procs) )
コードを見たら、いろいろやってるようだけど、本質部分は上記から辿ればいいんだな。 基本は、 gosh-traceっつう事で、さっと 見る事が出来ます。
break
コードを読むと三文の得。traceパッケージに、breakなんてのも入ってるよ。ちょっと 実験してみる。
#;3> (break me)
; setting break-point in me
#;4> (me)
Error: (me) *** breakpoint ***: (me)
Call history:
<syntax> (me)
<eval> (me) <--
#;4> (c)
226
#;5> (unbreak me)
; removing break-point in f_445
#;6> (break +)
; setting break-point in C_plus
#;7> (me)
Error: (C_plus) *** breakpoint ***: (C_plus 123 82)
Call history:
<syntax> (me)
<eval> (me)
<eval> [me] (+ (random 100) (random 100) (+ 123 (random 100)))
<eval> [me] (random 100)
<eval> [me] (random 100)
<eval> [me] (+ 123 (random 100))
<eval> [me] (random 100) <--
#;7> (c)
Error: (C_plus) *** breakpoint ***: (C_plus 53 20 205)
Call history:
<syntax> (c)
<eval> (c) <--
#;7> (c)
278
ちゃんと止まって、続きを実行出来た。こんなのが、自分自身（のschemeコードで）書けちゃう のがとっても素敵。