今回はKMRCLのstrings.lispから、ESCAPE-XML-STRINGです。
動作は、名前からなんとなく想像できますが、
(KL:ESCAPE-XML-STRING "(< x y)") ⇒ "(< x y)"
という感じです。
定義は、
(defun escape-xml-string (string) "Escape invalid XML characters" (substitute-chars-strings string '((#\& . "&") (#\< . "<"))))
となっています。
SUBSTITUTE-CHARS-STRINGSの使い道がいまいち分かりませんでしたが、ESCAPE-XML-STRINGのようなことをする場合は確かにうまくはまるなと思いました。
■
今回はKMRCLのstrings.lispから、SUBSTITUTE-CHARS-STRINGSです。
動作は、
(KL:SUBSTITUTE-CHARS-STRINGS "1234567890" '((#\0 . "00")
(#\1 . "11")
(#\2 . "22")
(#\3 . "33")
(#\4 . "44")
(#\5 . "55")
(#\6 . "66")
(#\7 . "77")
(#\8 . "88")
(#\9 . "99")))
⇒ "11223344556677889900"
となっていて、特定の文字を何らかの文字列に置き換えるもののようです。
定義は、
(defun substitute-chars-strings (str repl-alist)
"Replace all instances of a chars with a string. repl-alist is an assoc
list of characters and replacement strings."
(declare (simple-string str)
(optimize (speed 3) (safety 0) (space 0)))
(do* ((orig-len (length str))
(new-string (make-string (replaced-string-length str repl-alist)))
(spos 0 (1+ spos))
(dpos 0))
((>= spos orig-len)
new-string)
(declare (fixnum spos dpos) (simple-string new-string))
(let* ((c (char str spos))
(match (assoc c repl-alist :test #'char=)))
(declare (character c))
(if match
(let* ((subst (cdr match))
(len (length subst)))
(declare (fixnum len)
(simple-string subst))
(dotimes (j len)
(declare (fixnum j))
(setf (char new-string dpos) (char subst j))
(incf dpos)))
(progn
(setf (char new-string dpos) c)
(incf dpos))))))
となっているのですが、前回眺めたREPLACED-STRING-LENGTHを利用しています。
前回のREPLACED-STRING-LENGTHはいまいち用途が不明でしたが、このSUBSTITUTE-CHARS-STRINGSの補助関数だったようです。なるほど。
しかし、REPLACED-STRING-LENGTHに括り出している処理と同じような処理が、このSUBSTITUTE-CHARS-STRINGSにも含まれていて、なんとなく微妙です。
■
今回はKMRCLのstrings.lispから、REPLACED-STRING-LENGTHです。
動作は、
(KL::REPLACED-STRING-LENGTH "1234567890" '((#\0 . "00")
(#\1 . "11")
(#\2 . "22")
(#\3 . "33")
(#\4 . "44")
(#\5 . "55")
(#\6 . "66")
(#\7 . "77")
(#\8 . "88")
(#\9 . "99")))
;; (LENGTH "11223344556677889900")
⇒ 20
となっていて、なかなか使いどころが思い浮かびませんが、単一の文字を文字列に置き換えた場合の長さを求めるもののようです。
外部にEXPORTはされていません。
定義は、
(defun replaced-string-length (str repl-alist)
(declare (simple-string str)
(optimize (speed 3) (safety 0) (space 0)))
(do* ((i 0 (1+ i))
(orig-len (length str))
(new-len orig-len))
((= i orig-len) new-len)
(declare (fixnum i orig-len new-len))
(let* ((c (char str i))
(match (assoc c repl-alist :test #'char=)))
(declare (character c))
(when match
(incf new-len (1- (length
(the simple-string (cdr match)))))))))
となっていて、単純に文字列を走査してゆき該当の文字と文字列の対応が与えたALIST中にあれば文字列の長さ分を加えるというもののようです。
■
今回はKMRCLのstrings.lispから、STRING-TRIM-WHITESPACEです。
前回、前々回に引き続きで、今回は、行頭と行末の空白文字を削除する関数です。
動作は、
(DEFVAR *STRING* (FORMAT NIL "~%foo~%~%~% ")) *STRING* ⇒ " foo " (KL:STRING-TRIM-WHITESPACE *STRING*) ;⇒ "foo"
定義は、
(defun string-trim-whitespace (str) (string-trim *whitespace-chars* str))
となっています。
このSTRING-TRIM-WHITESPACEのことより、標準でSTRING-TRIMというものが用意されていたことの方に感心してしまいました。
■
GDB において特定の回数関数が呼ばれたら break する方法。
# break point を表示。番号を知る (gdb) info b Num Type Disp Enb Address What 1 breakpoint keep y 0x0000000000413fab in scheme::VM::runLoop(scheme::Object*, __jmp_buf_tag*, bool) at src/VM-Run.cpp:982 2 breakpoint keep y 0x000000000040e240 in scheme::VM::tryJitCompile(scheme::Object) at src/VM.cpp:957 breakpoint already hit 3 times # 2番の breakpoint において 121 回は通過し 122 回目で break するように指示 (gdb) ignore 2 121 Will ignore next 121 crossings of breakpoint 2. (gdb) r
事前に 122 回目の呼び出しで値がおかしくなる事が分かっている場合に上のようにデバッグする。
メンテナンスリリース。S式のシリアライズ（Fasl）が循環リストなどを正しく読み書きできるようになりました。
shiroさんに教わったのでメモっておきます
;;; from shiro
(defun gauche-info-index (topic)
(interactive
(list (read-string
(concat "Gauche help topic : ")
(current-word))))
(switch-to-buffer-other-window (get-buffer-create "*info*"))
(info "/usr/share/info/gauche-refe.info.gz")
;;(info "/usr/local/share/info/gauche-refe.info.gz") ;;うちは/usr/local/
(Info-index topic))
;;(define-key global-map "\C-xH" 'gauche-info-index) ;; original
(define-key global-map "\C-x\C-j" 'gauche-info-index) ;; naoya_t
キーバインドは C-x H だとシフト押すのが面倒なので、うちでは C-x C-j に移しました。（キーバインドは皆さんのお好みで！）
調べたい関数名の後でC-x C-jするとinfoが引けます。これは便利。
去年ちょっとだけ参加したTLE (Time Limit Exceeded)に今年は最初から参加。とは言っても仕事の合間にちょこちょこと。
（追記：恥ずかしいコードへのリンクを貼りました）
とりあえず通るコードを考えてsubmit x 8で最速全問通過（別にボーナスは無い）。しかしその後の詰めの能力は低いので順位は上がらず。瞬間最高順位は2位。
最終結果は438.1527点で19位。別枠でランキングのあるインド人トップより辛うじて上だけどそんなの関係ない。これはインドを舞台にした日本人同士の闘い。
パズル的にはとても面白かったけれどやはりゴルフ力が全然ないので、渋谷から10分のゴルフ場で鍛えるなどしたいです。
おまけ：副次的効果
gistに貼ってるだけだと忘れそうなのでここにもメモっとく。
「プログラミングErlang」の§12.2 に、ErlangからCの関数を利用する方法があるので、同等なインターフェイスを書けば
(define (twice x) (* 2 x)) (define (sum x y) (+ x y))
のようなScheme(Gauche)の関数も呼び出せる。
Eshell V5.7.4 (abort with ^G)
1> c(example1).
{ok,example1}
2> example1:start().
<0.39.0>
3> example1:twice(48).
96
4> example1:sum(17,25).
42
...
iVoca で単語の難易度を取得する API を試験リリース(項目反応理論) - Mi manca qualche giovedi`?。
これは Scheme コードバトンで使えそうだ。易しい順に出題とかできる。
Interpolative coding - tsubosakaの日記 より。
長さと出てくる値の最小値、最大値が分かっている狭義単調増加な自然数のリストを圧縮する方法の話。
最小値1、最大値20、長さ７の数列 [ 3, 8, 9, 11, 12, 13, 17 ] が17ビットに圧縮されるらしい。試してみたい。
まずはC++に翻訳しつつ写経。（Scheme編はこちら）
Schemeでも写経してみたの巻。C++編はこちら。
#;'(べ、べつにS式で書かないと理解できないわけじゃないんだからね)
(define (lg x) (integer-length (- x 1)))
(define (interpolative-encode L L-length lo hi)
(define (binary-encode x low high result)
(let* ([range (+ (- high low) 1)]
[bnum (lg range)]
[enc (- x low)])
(let loop ((i (- bnum 1)) (result result))
(if (< i 0) result
(loop (- i 1) (cons (if (logbit? i enc) 1 0) result))))))
(define (iter f lo hi left right result)
(cond [(= f 0) result]
[(= f 1) (binary-encode (vector-ref L left) lo hi result)]
[else
(let* ([h (quotient f 2)]
[m (vector-ref L (+ left h))]
[f1 h]
[f2 (- f h 1)])
(iter f2 (+ m 1) hi (+ left h 1) right
(iter f1 lo (- m 1) left (+ left h)
(binary-encode m (+ lo f1) (- hi f2) result))))]))
(let1 L-length (vector-length L)
(reverse! (iter L-length lo hi 0 L-length '())))
(define (interpolative-decode L L-length lo hi input-stream)
(define (binary-decode low high iter)
(let* ([range (+ (- high low) 1)]
[bnum (lg range)])
(let loop ((i 0) (dec 0) (iter iter))
(if (= i bnum)
(values (+ low dec) iter)
(let1 b (car iter)
(loop (+ i 1) (+ (* dec 2) (car iter)) (cdr iter)))))))
(define (iter f lo hi left right input-stream)
(cond [(= f 0) input-stream]
[(= f 1)
(receive (m stream) (binary-decode lo hi input-stream)
(vector-set! L left m)
stream)]
[else
(let* ([h (quotient f 2)]
[f1 h]
[f2 (- f h 1)])
(receive (m stream) (binary-decode (+ lo f1) (- hi f2) input-stream)
(vector-set! L (+ left h) m)
(iter f2 (+ m 1) hi (+ left h 1) right
(iter f1 lo (- m 1) left (+ left h) stream))))]))
(iter L-length lo hi 0 L-length input-stream))
(define (main args)
(let* ([L #(3 8 9 11 12 13 17)]
[lo 1]
[hi 20]
[L-length (vector-length L)]
[Ldec (make-vector L-length)]) ; 結果格納用vec
(print "original: " L)
(let1 encoded-bitstream (interpolative-encode L L-length lo hi)
(format #t "encoded (~d bits): ~a\n" (length encoded-bitstream) encoded-bitstream)
(interpolative-decode Ldec L-length lo hi encoded-bitstream)
(print "decoded: " Ldec))))
結果
original: #(3 8 9 11 12 13 17) encoded (17 bits): (0 1 1 1 1 1 0 0 1 0 0 0 0 0 0 1 1) decoded: #(3 8 9 11 12 13 17)
17bitに圧縮後、ちゃんと復号できて一安心。
(株)オーム社の森田さまより プログラミングClojure を献本いただきました。ありがとうございます。
Clojure を初めて知ったのは本書の訳者でもある Shiro さんの日記だったと記憶している。JVM 上で動く Lisp であること、言語デザインが優れている事などが挙げられていたように思う。その後 Clojure の名前は Hacker News などでたびたび見かけるようになり、気になっていたのだが本書が出版されるまで自分で触ってみる事はなかった。「新しいテクノロジへの追随は週に1-2時間でよろしい」という Rod Johnson の教えを守っている時期でもあったし。
本書はそんな Clojure がどんな言語であるかを教えてくれる貴重な日本語の書籍である。Lisp プログラマも、 Lisp になじみもない Java プログラマも何回もニヤリとする場面に遭遇すると思う。
Clojure への第一印象は「ああ。これは本気だな。本気の Lisp だ」というもの。読みながらメモした大小の特徴からもその本気が見えてくると思う。
自分は Clojure と Scheme の差分に着目して読み進めたが、「そうそう。やっぱりあれがないと話にならないよね」というものきちんと認識して組み込みで提供している。勝手な印象だが、Shiro さんの Gauche に良く似ていると思う。丁寧な作り込みと、実践や経験からくる組み込み機能提供のバランスの部分とか。
Clojure が Scala などとともに今後普及するかどうかは、現時点では怪しいと思うがそれでも野心的な Lisp 処理系なことには間違いない。Java 案件があったらこっそり Clojure で書いてみたいと思った。
しかし JRuby しかり Clojure しかり、JVM に乗っかった処理系たちは勢いがある。Clojure における再帰問題のように JVM も完璧ではないのだが、JVM に乗っかる事で得られる利益は僕が考えているよりは大きいのだろうな。
ちなみに Scheme が読み書きできるならば、以下の 2 つのコードを見比べてみると手っ取り早く Clojure との違いの雰囲気を知ることをできる。
こんな便利なものがあるなんて知らずに生きていた（恥）
Function: info symbol
Gaucheのinfoドキュメント中から、 symbolで指定される手続きか構文要素の定義を含んでいるページを表示します。 infoドキュメントは、もし環境変数INFOPATHが定義されていればそこに示されるディレクトリ中から探され、そうでなければgoshのライブラリディレクトリから推測されるディレクトリ中から探されます。infoドキュメントが見付からなかったり、見付かってもsymbolがIndexページ中に無かった場合はエラーとなります。つまり、この手続きはinfoファイルがインストールされていないと動作しません。
現在の出力ポートが端末である場合、infoドキュメントの該当ページはページングプログラムを用いて表示されます。環境変数PAGERが指定されていればそれを用い、そうでなければコマンドサーチパスからless及びmoreをこの順で探します。いずれも見付からなかった場合や、出力ポートが端末ではない場合には、単にページがそのまま出力されます。
この手続きのセッション中での最初の呼び出しは、infoファイルをパーズするために多少時間がかかります。
unfoldの引数の順番に迷った時とか、REPLから
gosh> (info 'unfold)
と打てば
10.2.5 List fold, unfold & map
------------------------------
...
... (foldとかreduceとかの定義)
...
-- Function: unfold p f g seed &optional tail-gen
[SRFI-1] Fundamental recursive list constructor. Defined by the
following recursion.
(unfold p f g seed tail-gen) ==
(if (p seed)
(tail-gen seed)
(cons (f seed)
(unfold p f g (g seed))))
That is, P determines where to stop, G is used to generate
successive seed value from the current seed value, and F is used
to map each seed value to a list element.
...
qを打てばまたREPLに戻って来られる。これは便利。
id:leque さんがバトンきっかけで発見・修正してくださった物。ありがたい。
久々にMeCabを使いたくなったのでGauche-mecabをインストールしたい（が少しはまった）のでメモ。
1. ビルドはGauche-0.9でもSnow Leopardでも行けるっぽい。
2. ビルドはできるが make check で失敗する。
mecab-lib.$(SOEXT): $(srcdir)/mecab-lib.scm
$(GENCOMP) --ext-module=text/mecab.scm $(srcdir)/mecab-lib.scm
$(GAUCHE_PACKAGE) compile \
--local=$(LOCAL_PATHS) --ldflags='-L/usr/local/lib' --libs='-lmecab' --verbose mecab-lib mecab-lib.c
のようにldflagsでなんとかすれば良いレベル。
higeponさんから始まったコードバトンがkazu634さんから回ってきた話、の後編。
higeponさんから始まったコードバトン、のSchemeブランチ（というか本流）がkazu634さんから回ってきた。
コードがmoshべったりになってるので、とりあえずmoshで動かしてみるか。
と思ったらこのマシンにはmoshが入っていない。
HEADを入れるにしてもmosh-0.2.0が要るみたいなので0.2.0を貰ってきて
$ ./configure checking build system type... i386-apple-darwin10.2.0 checking host system type... i386-apple-darwin10.2.0 checking target system type... i386-apple-darwin10.2.0 checking for a BSD-compatible install... /usr/bin/install -c ... configure: error: GNU MP not found, see http://gmplib.org/."For OSX, install GNU MP with "CFLAGS+=-m32 ./configure ABI=32 && make"
これは見たことありますね。GNU MPが入ってない旨のメッセージ。
higeponさんから始まったコードバトンに参加。なぜかCommon Lispフォークの方に呼ばれた…
snmsts: 誰もアイデアが無いんだったら自薦者としてはmasatoiさん他薦として higepon（敬称含む）を推します。> naoya_tさん 個人的にはschemerを舐めていきたい。 (※下線は筆者)
SchemerとCLerの生暖かい交流（というか人材の奪い合い）が心に残ります。
登録された単語からの検索機能 (hige:pan) を実装しました。
$ sbcl This is SBCL 1.0.29, an implementation of ANSI Common Lisp. More information about SBCL is available at <http://www.sbcl.org/>. SBCL is free software, provided as is, with absolutely no warranty. It is mostly in the public domain; some portions are provided under BSD-style licenses. See the CREDITS and COPYING files in the distribution for more information. * (load "scheme_baton.lisp") ; ... T * (in-package :cl-user) #<PACKAGE "COMMON-LISP-USER"> * (in-package :hige) #<PACKAGE "HIGE"> *
で (pon) (pin) (pun) とかして遊べるようになります。
以下diffです：
(via @finalfusion)
郵便事業株式会社は、平成17年(2005年)にシリーズが始まり、数々の人気アニメを題材としてきた「アニメ･ヒーロー・ヒロインシリーズ」の第12集「ケロロ軍曹」を発行いたします。
これはぜひ欲しいですね。
Scheme のコードをバトンのように回していき面白い物ができあがるのを楽しむ遊びを始めました。
盛り上がるようであれば次回 Shibuya.lisp で成果を発表したいと思っています。
もしご興味のある方がいらっしゃいましたら、コメントで表明していただくとバトンが回ってくる対象となります。
とても短いコードをいじっていくので Scheme 初心者の方でも参加歓迎です。（分からない事があればフォローします。）
詳細はこちらをどうぞ。http://gist.github.com/273431
現在 higepon -> yadokarielectri さんとバトンが渡っています。
g000001 さん、yshigeru さん、garaemon さん、yadokarielectri さん、leque さん
Common Lisp バトンの動きもあるようです。どちらが面白い物を作れるかな。
garaemon さんの表現が面白い。
愛すべきバカだなあ。
次回 Shibuya.lisp のネタ。「英単語覚えるスクリプト」のように短くていじりやすいコードを github に置いてコードバトンをするのはどうかな。ルールは2つ
次回 Shibuya.lisp までこのバトンをまわしておくとあっと驚く物ができるんじゃないかな。あと初心者の人でもいじりやすいように、twitter の shibuya.lisp アカウントに質問してくれれば何でも答えるというサポート体制を置くとか。
Scheme を触る良いきっかけになればと思うんだけど、どうですか？やりたい人いるかな？
Shibuya.lisp の発表で少し触れた、英単語覚えるスクリプトを改善した。毎日使っていて単語量が増えたので誤り回数が多い物順に出題する事にした。
(import (rnrs) (mosh control) (mosh) (match) (mosh file) (srfi :8) (only (srfi :1) first second)) (define (sort-word-spec* word-spec*) (list-sort (match-lambda* [((_a _b ok-count1 ng-count1) (_c _d ok-count2 ng-count2)) (> (- ng-count1 ok-count1) (- ng-count2 ok-count2))]) ;; normalization (map (match-lambda [(word meaning) (list word meaning 0 0)] [(word meaning ok-count ng-count) (list word meaning ok-count ng-count)]) word-spec*))) (define (main args) (let1 result* (call/cc (lambda (break) (let loop ([word-spec* (sort-word-spec* (file->sexp-list (second args)))] [result-spec* '()]) (match word-spec* [() result-spec*] [((word meaning ok-count ng-count) . more) (format #t "~s: " word) (read (current-input-port)) (format #t "~s y/n? " meaning) (case (read-char (current-input-port)) [(#\y #\Y) (loop more (cons (list word meaning (+ ok-count 1) ng-count) result-spec* ))] [(#\N #\n) (loop more (cons (list word meaning ok-count (+ ng-count 1)) result-spec*))] [(#\q #\Q) (break (append (reverse result-spec*) word-spec*))])])])) (call-with-port (open-file-output-port (second args) (make-file-options '(no-fail)) 'block (native-transcoder)) (lambda (p) (for-each (lambda (x) (write x p) (newline p)) result*))))) (main (command-line))
match-lambda を使っているのは Erlang で便利さに気づいたから。
JIT コンパイラが Scheme で書かれているので、JIT コンパイラ自身も JIT コンパイルされる可能性があることに気付いた。そうすると
と繰り返されてしまう。同じ手続き B が再帰的に何回も JIT コンパイルされるのが問題なので、手続き B にコンパイル中フラグをつければ良いかと思ったがそうも行かない。
例えば以下のような場合を考えれば分かる。
(define (jit-compile x) ... ... (map (lambda (x) (+ x 2)) lst) ...)
手続き B が (lambda (x) (+ x 2)) だとすると jit-compile の呼び出し毎に、新しい手続きがアロケーションされるので、ソースコード上は同じ手続きでも実行時には別の手続きなのだ。(コンパイラが賢ければ、(lambda (x) (+ x 2)) を静的にくくりだす事も可能だがそれはまた別の話なので置いておく)
上記のような事情から、JIT コンパイラは再帰的に起動しない。グローバルで JIT コンパイル中フラグを持つ。という方針にしようかと思う。ただし欠点があって良く呼ばれるであろう JIT コンパイラ自身が JIT の恩恵を受けられない。
もっと良い方法はないだろうか。
ここしばらく本体となるピンボールゲームの開発に忙しくイプシロン関連の更新が滞っております :(
新タイトル「MAD DAEDALUS（仮称）」が完成しましたら、その成果をイプシロンにフィードバックいたします、どうぞしばらくお待ち下さい m(_ _)m
Shibuya Lisp TT#2の発表の時に使った"JelloBench"です :)
テクスチャマッピングされたポリゴンをSDL/OpenGLで描画しています。
プログラムはすべてSchemeで書かれていますが、Intel Core2 2.4GHzのLinuxで3500フレーム/秒以上の表示が可能です。
JelloBenchの実行には開発版のイプシロン(http://code.google.com/p/ypsilon/)とSDL, SDL_image, SDL_mixerが必要です。MacOSXでは最初にSDL.framework, SDL_image.framework, SDL_mixer.frameworkをインストールしておいてください。インプシロンのビルド時にSDL初期化用のdylibが作成され/usr/local/lib/ypsilon/に自動的にインストールされます。
JelloBenchは'example'にカレントディレクトリを移動してから'ypsilon jello.scm'で実行してください。
今回追加したMacOSXのSDLサポートにはid:kazuya_aさんがypsilon+SDL+Mac OSX!に紹介された方法を使っています。これによりSDL専用のイプシロンをビルドする必要がなくなりました。感謝です！:)
(6/13追記：動画を再エンコードしました)
野田 開さんのご厚意によりPS3をSSH経由で提供して頂きました m(_ _)m
32bit/64bit対応でFFIもサポート済みですよ。 :)
libspe2を使ったテストプログラムを作ってみました。
svn trunkのイプシロンをPS3に入れると動きます＾＾b
#!/usr/bin/env ypsilon #!r6rs ;; ps3-cell-demo.scm ;; tested on PS3 Linux (import (rnrs) (only (core) system format iota) (ypsilon ffi) (ypsilon concurrent) (ypsilon cell libspe2)) (define spe-code " #include <stdio.h> int main(unsigned long long spe_id, unsigned long long pdata) { printf(\"SPE:0x%llx sleep for 2 second\\n\", spe_id); sleep(2); printf(\"SPE:0x%llx exit\\n\", spe_id); return 0; }\n") (define NULL 0) (define source-file "spe_example.c") (define object-file "spe_example") (define make-spe-program (lambda () (when (file-exists? source-file) (delete-file source-file)) (call-with-port (open-output-file source-file) (lambda (port) (put-string port spe-code))) (unless (= (system (format "spu-gcc ~a -o ~a" source-file object-file)) 0) (error 'make-spe-program "unexpected error")))) (make-spe-program) (newline) ;; sequential (let ((image (spe_image_open object-file))) (when (= image NULL) (error 'spe_image_open "unexpected error")) (for-each (lambda (n) (let ((context (spe_context_create (+ SPE_EVENTS_ENABLE SPE_MAP_PS) NULL))) (when (= context NULL) (error 'spe_context_create "unexpected error")) (spe_program_load context image) (let ((entry (make-c-int SPE_DEFAULT_ENTRY))) (format #t "-- kick sequential run ~a/6\n" n) (when (< (spe_context_run context entry 0 0 NULL NULL) 0) (error 'spe_context_run "unexpected error")) (spe_context_destroy context)))) (iota 6)) (spe_image_close image)) (newline) (newline) ;; parallel (let ((image (spe_image_open object-file))) (when (= image NULL) (error 'spe_image_open "unexpected error")) (let ((threads (map (lambda (n) (format #t "-- kick parallel run ~a/6\n" n) (future (let ((context (spe_context_create (+ SPE_EVENTS_ENABLE SPE_MAP_PS) NULL))) (when (= context NULL) (error 'spe_context_create "unexpected error")) (spe_program_load context image) (let ((entry (make-c-int SPE_DEFAULT_ENTRY))) (when (< (spe_context_run context entry 0 0 NULL NULL) 0) (error 'spe_context_run "unexpected error")) (spe_context_destroy context))))) (iota 6)))) (format #t "== wait for all SPE exit\n") (for-each (lambda (x) (x)) threads)) (spe_image_close image))
このプログラムは、最初に一つのSPEで順次実行し、次に6個のSPEで並列実行します。
$ ypsilon example/ps3-cell-demo.scm -- kick sequential run 0/6 SPE:0x101b4340 sleep for 2 second SPE:0x101b4340 exit -- kick sequential run 1/6 SPE:0x101b4340 sleep for 2 second SPE:0x101b4340 exit -- kick sequential run 2/6 SPE:0x101b4340 sleep for 2 second SPE:0x101b4340 exit -- kick sequential run 3/6 SPE:0x101b4340 sleep for 2 second SPE:0x101b4340 exit -- kick sequential run 4/6 SPE:0x101b4340 sleep for 2 second SPE:0x101b4340 exit -- kick sequential run 5/6 SPE:0x101b4340 sleep for 2 second SPE:0x101b4340 exit -- kick parallel run 0/6 -- kick parallel run 1/6 -- kick parallel run 2/6 -- kick parallel run 3/6 SPE:0x101b5230 sleep for 2 second SPE:0x101b5170 sleep for 2 second SPE:0x101b52f0 sleep for 2 second SPE:0x1020c248 sleep for 2 second -- kick parallel run 4/6 -- kick parallel run 5/6 == wait for all SPE exit SPE:0x10223910 sleep for 2 second SPE:0x10237e48 sleep for 2 second SPE:0x101b5230 exit SPE:0x101b52f0 exit SPE:0x101b5170 exit SPE:0x1020c248 exit SPE:0x10223910 exit SPE:0x10237e48 exit
うまく動いているようです :D
ところでpowerpcはわたしの好きなCPUの一つなのですが、やはりあのニーモニックは微妙・・・思い出せばなんでもないことなんですけどね :p
SSH経由なのでエディタはemacsを使いました。どこでも同じものが動くというのは素晴らしいことです！でも・・・あいかわらず・・・普段はほとんど使っていません（笑
example/sdl-ttf-demo.scmの表示です :)
やっぱりハッシュテーブルだけだとキツイです・・・
で、餅は餅屋ということでMySQL 5.1 C APIのバインディングを追加しました。
$ ypsilon Ypsilon 0.9.6-trunk/r443 Copyright (c) 2009 Y.Fujita, LittleWing Company Limited. > (import (ypsilon mysql)) > (define NULL 0) > (define user "root") > (define passwd "...") > (define mysql (mysql_init NULL)) > (if (zero? (mysql_real_connect mysql "localhost" user passwd "mysql" 0 NULL 0)) (display (mysql_error mysql)) (display (mysql_stat mysql))) Uptime: 52318 Threads: 1 Questions: 7 Slow queries: 0 Opens: 12 Flush tables: 1 ... > (mysql_close mysql)
このままだと使いにくいので何か考えたいですね :)