いやぁ、あのときは勉強不足でイテレータの使い方が、というよりもチャンクの使い方がよく分からなくて挫折したんだよね。でも今回はちょっと違うぜ
使ったQDBMのバージョンは最新だと思われる1.8.21、Windowsのバイナリであります。それを解凍して出てくるディレクトリの中にあるDLLを全てxyzzy.exeと同じディレクトリに放り込んでおきます。以上が下準備その１
次に以下のコードをqdbm.lとして$XYZZYHOME/site-lisp以下に放り込んでおきましょう
;;; -*- MODE: Lisp; PACKAGE: QDBM; -*-
;;;
(defpackage "qdbm"
(:use "lisp" "editor" "foreign"))
(c::*define-c-struct DEPOT
((char *) name) ; /* type of structure for a database handle */
(c::int wmode) ; /* name of the database file */
(c::int inode) ; /* whether writable or not */
(c::int mtime) ; /* inode of the database file */
(c::int fd) ; /* last modified time of the database */
(c::int fsiz) ; /* file descriptor of the database file */
((char *) map) ; /* size of the database file */
(c::int msiz) ; /* pointer to the mapped memory */
((c::int *) buckets) ; /* pointer to the bucket array */
(c::int bnum) ; /* number of the bucket array */
(c::int rnum) ; /* number of records */
(c::int fatal) ; /* whether a fatal error occured or not /*
(c::int ioff) ; /* offset of the iterator */
(c::int mroff) ; /* offset of the last moved region */
(c::int mrsiz) ; /* size of the last moved region */
(c::int align)) ; /* basic size of alignment */
(c::*define DP_ENOERR 0) ;/* no error */
(c::*define DP_EFATAL 1) ;/* with fatal error */
(c::*define DP_EMODE 2) ;/* invalid mode */
(c::*define DP_EBROKEN 3) ;/* broken database file */
(c::*define DP_EKEEP 4) ;/* existing record */
(c::*define DP_ENOITEM 5) ;/* no item found */
(c::*define DP_EALLOC 6) ;/* memory allocation error */
(c::*define DP_EMAP 7) ;/* memory mapping error */
(c::*define DP_EOPEN 8) ;/* open error */
(c::*define DP_ECLOSE 9) ;/* close error */
(c::*define DP_ETRUNC 10) ;/* trunc error */
(c::*define DP_ESYNC 11) ;/* sync error */
(c::*define DP_ESTAT 12) ;/* stat error */
(c::*define DP_ESEEK 13) ;/* seek error */
(c::*define DP_EREAD 14) ;/* read error */
(c::*define DP_EWRITE 15) ;/* write error */
(c::*define DP_ELOCK 16) ;/* lock error */
(c::*define DP_EUNLINK 17) ;/* unlink error */
(c::*define DP_EMKDIR 18) ;/* mkdir error */
(c::*define DP_ERMDIR 19) ;/* rmdir error */
(c::*define DP_EMISC 20) ;/* miscellaneous error */
(c::*define DP_OREADER (ash 1 0)) ; /* open as a reader */
(c::*define DP_OWRITER (ash 1 1)) ; /* open as a writer */
(c::*define DP_OCREAT (ash 1 2)) ; /* a writer creating */
(c::*define DP_OTRUNC (ash 1 3)) ; /* a writer truncating */
(c::*define DP_ONOLCK (ash 1 4)) ; /* open without locking */
(c::*define DP_OSPARSE (ash 1 5)) ; /* create as a sparse file */
(c::*define DP_DOVER 0) ; /* overwrite an existing value */
(c::*define DP_DKEEP 1) ; /* keep an existing value */
(c::*define DP_DCAT 2) ; /* concatenate values */
(let ((dll "qdbm.dll"))
(c::*define-dll-entry (DEPOT *) dpopen ((char *) c::int c::int) dll)
(c::*define-dll-entry c::int dpclose ((DEPOT *)) dll)
(c::*define-dll-entry c::int dpput ((DEPOT *) (char *) c::int (char *) c::int c::int) dll)
(c::*define-dll-entry c::int dpout ((DEPOT *) (char *) c::int) dll)
(c::*define-dll-entry (char *) dpget ((DEPOT *) (char *) c::int c::int c::int (c::int *)) dll)
(c::*define-dll-entry c::int dpgetwb ((DEPOT *) (char *) c::int c::int c::int (char *)) dll)
(c::*define-dll-entry c::int dpvsiz ((DEPOT *) (char *) c::int) dll)
(c::*define-dll-entry c::int dpiterinit ((DEPOT *)) dll)
(c::*define-dll-entry (char *) dpiternext ((DEPOT *) (c::int *)) dll)
(c::*define-dll-entry c::int dpsetalign ((DEPOT *) c::int) dll)
(c::*define-dll-entry c::int dpsync ((DEPOT *)) dll)
(c::*define-dll-entry c::int dpoptimize ((DEPOT *) c::int) dll)
(c::*define-dll-entry (char *) dpname ((DEPOT *)) dll)
(c::*define-dll-entry c::int dpfsiz ((DEPOT *)) dll)
(c::*define-dll-entry c::int dpbnum ((DEPOT *)) dll)
(c::*define-dll-entry c::int dpbusenum ((DEPOT *)) dll)
(c::*define-dll-entry c::int dprnum ((DEPOT *)) dll)
(c::*define-dll-entry c::int dpwritable ((DEPOT *)) dll)
(c::*define-dll-entry c::int dpfatalerror ((DEPOT *)) dll)
(c::*define-dll-entry c::int dpinode ((DEPOT *)) dll)
(c::*define-dll-entry c::int dpmtime ((DEPOT *)) dll)
(c::*define-dll-entry c::int dpfdesc ((DEPOT *)) dll)
(c::*define-dll-entry c::int dpremove ((char *)) dll)
(c::*define-dll-entry c::int dprepair ((char *)) dll)
(c::*define-dll-entry c::int dpexportdb ((DEPOT *) (char *)) dll)
(c::*define-dll-entry c::int dpimportdb ((DEPOT *) (char *)) dll)
(c::*define-dll-entry c::int dpinnerhash ((char *) c::int) dll)
(c::*define-dll-entry c::int dpouterhash ((char *) c::int) dll)
(c::*define-dll-entry c::int dpprimenum (c::int) dll)
(c::*define-dll-entry c::void dpecodeset (c::int (char *) c::int) dll)
(c::*define-dll-entry (c::int *) dpecodeprt () dll)
(c::*define-dll-entry c::int dpmemsync ((DEPOT *)) dll)
(c::*define-dll-entry c::int dpgetflags ((DEPOT *)) dll)
(c::*define-dll-entry c::int dpsetflags ((DEPOT *) c::int) dll)
)
次にテスト用スクリプト。こっちはqdbmtest.lとでもしておいて、さっきと同様$XYZZYHOME/site-lisp以下に置いておきます
(require "qdbm")
(defconstant dpdatabase "DEPOT.qdbm")
(setq db (make-DEPOT))
(defmacro qdbm-dbopen (command dbname mode bucket)
`(let ((result nil))
(setq result (,command ,dbname ,mode ,bucket))
(insert
(format nil
"~20a ~[failed. ~;success.~] [~a]\n"
',command
(if (eql 0 result)
0
1)
result))
result))
(defmacro qdbm-test-1 (test error-value command cmdname &rest args)
`(let ((result nil)
(rval nil))
(setq rval (,command ,@args))
(setq result
(funcall ,test ,error-value rval))
(insert (format nil
"~20a ~[failed. ~;success.~] [~a]\n"
',cmdname (if result 0 1) rval))
(if result nil t)))
(defun qdbm-test ()
(interactive)
(let ((result nil)
(dkey (si:make-string-chunk "dummy-key"))
(dval (si:make-string-chunk "dummy-value"))
)
(insert (format nil "~20a command-result\n" 'command))
;;; qdbm::DEPOT test
(let ((db nil))
(and
(progn
(setq db (qdbm-dbopen
dpopen
(si:make-string-chunk dpdatabase)
(logior DP_OWRITER DP_OCREAT)
0))
(if (eql db 0) nil t))
(qdbm-test-1 'eql 0 dpclose dpclose db)
(progn
(setq db (qdbm-dbopen
dpopen
(si:make-string-chunk dpdatabase)
(logior DP_OWRITER DP_OCREAT)
0))
(if (eql db 0) nil t))
(qdbm-test-1 'eql 0 dpput dpput db dkey -1 dval -1 DP_DKEEP)
(qdbm-test-1 'eql 1 dpput dpput[DP_DKEEP] db dkey -1 dval -1 DP_DKEEP)
(qdbm-test-1 'eql 0 dpput dpput[DP_DOVER] db dkey -1 dval -1 DP_DOVER)
(qdbm-test-1 'eql 0 dpout dpout db dkey -1)
(qdbm-test-1 'eql 0 dpput dpput[DP_DCAT] db dkey -1 dval -1 DP_DCAT)
(qdbm-test-1 'eql 0 dpput dpput[DP_DCAT] db dkey -1 dval -1 DP_DCAT)
(qdbm-test-1 'eql 0 dpclose dpclose db)
(progn
(setq db (qdbm-dbopen
dpopen (si:make-string-chunk dpdatabase)
DP_OREADER 0))
(if (eql db 0) nil t))
(qdbm-test-1 'eql 0 dpget dpget db dkey -1 0 -1 0)
(qdbm-test-1 'eql 0 dpclose dpclose db)
(progn (setq db (qdbm-dbopen
dpopen (si:make-string-chunk dpdatabase)
DP_OREADER 0))
(if (eql db 0) nil t))
(progn
(let ((buf (si:make-chunk 'string 300)))
(qdbm-test-1 'eql -1 dpgetwb dpgetwb db dkey -1 0 (si:chunk-size buf) buf)))
(qdbm-test-1 'eql -1 dpvsiz dpvsiz db dkey -1)
(qdbm-test-1 'eql 0 dpiterinit dpiterinit db)
(qdbm-test-1 'eql 0 dpiternext dpiternext db 0)
(qdbm-test-1 'eql 0 dpclose dpclose db)
(progn (setq db (qdbm-dbopen
dpopen (si:make-string-chunk dpdatabase)
DP_OWRITER 0))
(if (eql db 0) nil t))
(qdbm-test-1 'eql 0 dpsetalign dpsetalign db 15)
(qdbm-test-1 'eql 0 dpsync dpsync db)
(qdbm-test-1 'eql 0 dpoptimize dpoptimize db -1)
(qdbm-test-1 'eql 0 dpname dpname db)
(qdbm-test-1 'eql -1 dpfsiz dpfsiz db)
(qdbm-test-1 'eql -1 dpbnum dpbnum db)
(qdbm-test-1 'eql -1 dpbusenum dpbusenum db)
(qdbm-test-1 'eql -1 dprnum dprnum db)
(qdbm-test-1 'eql 0 dpwritable dpwritable db)
(qdbm-test-1 'eql 1 dpfatalerror dpfatalerror db)
(qdbm-test-1 'eql -1 dpinode dpinode db)
(qdbm-test-1 'eql 0 dpmtime dpmtime db)
(qdbm-test-1 'eql 0 dpfdesc dpfdesc db)
(qdbm-test-1 'eql 0 dpclose dpclose db)
(qdbm-test-1 'eql 0 dprepair dprepair (si:make-string-chunk dpdatabase))
(progn (setq db (qdbm-dbopen
dpopen (si:make-string-chunk dpdatabase)
DP_OREADER 0))
(if (eql db 0) nil t))
(let ((exportdb (si:make-string-chunk (format nil "ext~a" dpdatabase)))
(importdb (si:make-string-chunk (format nil "imp~a" dpdatabase))))
(qdbm-test-1 'eql 0 dpexportdb dpexportdb db exportdb)
(qdbm-test-1 'eql 0 dpclose dpclose db)
(progn (setq db (qdbm-dbopen
dpopen importdb
(logior DP_OWRITER DP_OCREAT) 0))
(if (eql db 0) nil t))
(qdbm-test-1 'eql 0 dpimportdb dpimportdb db exportdb)
(qdbm-test-1 'eql 0 dpclose dpclose db)
(qdbm-test-1 'eql 0 dpremove dpremove exportdb)
(qdbm-test-1 'eql 0 dpremove dpremove importdb)
)
(progn (setq db (qdbm-dbopen
dpopen (si:make-string-chunk dpdatabase)
DP_OREADER 0))
(if (eql db 0) nil t))
(qdbm-test-1 'eql 0 dpinnerhash dpinnerhash dkey -1)
(qdbm-test-1 'eql 0 dpouterhash dpouterhash dkey -1)
(qdbm-test-1 'eql 0 dpprimenum dpprimenum 100)
(insert "\n[DEPOT] All the commands succeeded. \n\n"))
(qdbm-test-1 'eql 0 dpclose dpclose db)
(qdbm-test-1 'eql 0 dpremove dpremove (si:make-string-chunk dpdatabase))
)))
両方をファイルに保存したら、新しいxyzzyを立ち上げて、*scratch*バッファにでも以下を打ち込んで
C-Enterで評価
(*1)。そして、
M-x qdbm-test。全てのコマンドが成功して、
command command-result
dpopen success. [44571456]
dpclose success. [1]
dpopen success. [44571536]
dpput success. [1]
dpput[DP_DKEEP] success. [0]
dpput[DP_DOVER] success. [1]
dpout success. [1]
dpput[DP_DCAT] success. [1]
dpput[DP_DCAT] success. [1]
dpclose success. [1]
dpopen success. [44571616]
dpget success. [44571696]
dpclose success. [1]
dpopen success. [44571728]
dpgetwb success. [22]
dpvsiz success. [22]
dpiterinit success. [1]
dpiternext success. [44571808]
dpclose success. [1]
dpopen success. [44571824]
dpsetalign success. [1]
dpsync success. [1]
dpoptimize success. [1]
dpname success. [44572304]
dpfsiz success. [135]
dpbnum success. [5]
dpbusenum success. [1]
dprnum success. [1]
dpwritable success. [2]
dpfatalerror success. [0]
dpinode success. [0]
dpmtime success. [1111157015]
dpfdesc success. [3]
dpclose success. [1]
dprepair success. [1]
dpopen success. [44572496]
dpexportdb success. [1]
dpclose success. [1]
dpopen success. [44569152]
dpimportdb success. [1]
dpclose success. [1]
dpremove success. [1]
dpremove success. [1]
dpopen success. [44569600]
dpinnerhash success. [776845421]
dpouterhash success. [277264121]
dpprimenum success. [103]
[DEPOT] All the commands succeeded.
dpclose success. [1]
dpremove success. [1]
なんて出力が得られたらxyzzyから動かした時の動作確認は終了です
(*2)。ちなみに[]の中の数値は多少違うことになると思うので、そっちは気にしなくてもいいでしょう。さて次にいよいよイテレータを動かします。前回もイテレータは動いていたのですが、戻り値が(char *)なんていう型だったので、xyzzyでどういう風にやれば文字列に戻せるのか分からなかったのですが、以下のようにすればxyzzyで読める文字列に変換することが出来ることが分かったでありますよ
(require "qdbm")
; データベース名の設定
(setq dbname (si:make-string-chunk "DEPOT.qdbm"))
; 登録するキー１、キー２
(setq dkey (si:make-string-chunk "dummy-key"))
(setq dkey2 (si:make-string-chunk "dummy-key2"))
; 登録する値１、値２
(setq dval (si:make-string-chunk "dummy-value"))
(setq dval2 (si:make-string-chunk "dummy-value2"))
; データベースを書き込みモードで開く
(setq db (dpopen dbname (logior DP_OWRITER DP_OCREAT) 0))
; キー、値の書き込み
(dpput db dkey -1 dval -1 DP_DKEEP)
(dpput db dkey2 -1 dval2 -1 DP_DKEEP)
; データベースを閉じる
(dpclose db)
; データベースを読み取りモードで開く
(setq db (dpopen dbname DP_OREADER 0))
; イテレータの初期化
(setq iterator (dpiterinit db))
; 取得データのサイズを書き込むための領域を確保
(setq size (si:make-chunk 'c::int 4))
; イテレータを使ってキーが書き込まれている領域へのポインタを取得
(setq buf-pointer (dpiternext db size))
; 書き込まれた領域を参照するチャンクの作成
(setq buf (si:make-chunk 'char (si:unpack-int32 size 0) nil buf-pointer))
; lispで読み込める形に変換
(setq keyname (si:unpack-string buf 0 (si:unpack-int32 size 0)))
"dummy-key"
; チャンクをクリア
(si:clear-chunk buf)
(si:clear-chunk size)
; 値の取得
(setq buf-pointer (dpget db (si:make-string-chunk keyname) -1 0 -1 size))
; 書き込まれた値の領域を参照するチャンクの作成
(setq buf (si:make-chunk 'char (si:unpack-int32 size 0) nil buf-pointer))
; lispで読み込める形に変換
(setq valuename (si:unpack-string buf 0 (si:unpack-int32 size 0)))
"dummy-value"
(dpclose db)
1
コメントも一緒でちょっと分かりづらいですが。ようするに(char *)で戻ってくるのが領域の先頭のアドレスということなので、そこを先頭とするチャンクを作ってしまえば、あとはxyzzyで読み込めるわけだったんですね。何で前は気がつかなかったんだろう(^^;
でもこれでとりあえずイテレータも使えることが分かったし、Curiaも動かせるかも、という希望が見えてきたですよ(^^;
$Date: 2005-03-19 00:06:57 +0900 (Sat, 19 Mar 2005) $ $HeadURL: file:///G:/repo/ndiary_log/2005/03/20050318.diary $
