2012/12/06

Lispでメモリに直接触る

(これはLisp Advent Calendar 2012の7日目の記事です。)

Lispは抽象度の高い言語だが、 必要があればC言語と同じように手動でメモリ管理したり、 直接メモリにアクセスしたりできる。 実際、例えばGC自身をLispで書くためにはGCに頼るわけにいかないのだし。

最近仕事ではそんな感じのコードを良く書いてるのだが、 こういうLispっぽくないコードは紹介される機会が少ないように思うので、 今日はそうした「ボンネットの下」をちょっとお見せする。

なお、コードはAllegro Common Lisp (ACL) 限定。

addressとaligned address

メモリを読み書きするAPIとして、わかりやすいのはsys:memref-intだ。

(sys:memref-int addr offset pos type &optional coerce)

これはメモリアドレス (+ addr offset pos) から値を読み出す。 type には :signed-byte とか :unsigned-word とか :unsigned-long とか指定する。詳しくはマニュアルを参照。

(setf (sys:memref-int addr offset pos type &optional coerce) value)

という具合に使えば、該当アドレスに値をセットすることもできる。

渡されたアドレスが有効なものかどうか、Lisp側ではチェックしないので、 適当なアドレスを渡したらSEGVったりどっか壊したりする。 どうやって有効なアドレスを得るかは後述。

addr, offset, posのうち、offsetとposはfixnum限定。addrはintegerであれば良い。 offsetとposは別の名前がついてるけど、意味的に差は無い。 なんで別々に渡すようになってるかというと、その方が良い機械語を生成できる 可能性があるから (インデックス付きレジスタ間接モードがあるCPUなら、 例えばposが定数の時わざわざ加算命令を使わなくてもロード時に (+ addr offset pos) を計算できる)。

これさえあれば任意のアドレスに読み書きできるので、理屈の上ではこれで十分なんだが、 実際のコードでは sys:memref-int はあまり使わない。addr に bignumが渡ってくる可能性があるってことは、型チェックおよび整数値のunboxingが 必要になるってことだ。しかしこういう低レベルなコードを書く時ってのは 性能を絞り出したい時でもあるんで、メモリ参照の度に余分なコードが入るのは痛い。 また、addr計算時にbignumが生じるとアロケーションが起きる。

もうひとつ、良く似た名前の sys:memref という関数がある。

(sys:memref object offset pos type &optional coerce)

マニュアルにはこう書いてあるんだけど、予備知識無しでは動作がすぐにはわからないかもしれない。

The object argument may be any Lisp value. If the Lisp value represents an object in the heap, the address of the object (including its tag) is used as the base address in the memory reference. If the Lisp value is an immediate value (a fixnum, a character, ...), then the actual bit representation of the Lisp value (including its tag) is used as the base address in the memory reference.

Lispのオブジェクトは、内部的にはタグ付きポインタかタグ付き即値データの形を取る。 sys:memrefの object 引数は、Lispオブジェクトを受けとると、 そのビットパターンをそのままアドレスと解釈する。

つまり、Lispオブジェクトのメモリレイアウトを知っていれば、タグを考慮したオフセットを 計算することでLispオブジェクトのメモリ表現を直にいじることができる。 (Lispオブジェクトのメモリレイアウトについては公式なドキュメントは無いのだけれど、 Allegro CLインストールディレクトリの misc/lisp.h を見ると何となく雰囲気は わかるだろう。アーキテクチャ毎にオフセットは違うし、あんまりちゃんとドキュメント されてないのでいじるのは面倒だろうけど。私も、x86_64ではsimple-arrayに対して -2オフセットしてやると配列の先頭アドレスになる、っていうのしか使ったことない)。

おもしろいのはobjectが即値データのfixnumである場合だ。

fixnumは、ACLではタグ0、つまり整数値を単に左シフト (64bitアーキテクチャでは3bit、 32bitアーキテクチャでは2bit) した表現になっている。

ところで、メモリ上のデータの塊は8(4)バイトなりの境界に配置されることが多い (括弧内は32bitアーキテクチャの場合。以下同様)。 つまりその先頭アドレスの下位3(2)bitは00であることが圧倒的に多い。

そこでACLでは、できるだけ実際のメモリアドレスを3(2)bit右シフトした値を使う。 これをaligned addressと呼ぶ。aligned addressは必ずfixnumの範囲に収まる。 そして、fixnumのタグがあるために、マシンレジスタ上ではaligned addressの 表現型がそのままマシンアドレスになっている。

すなわち、sys:memref にaligned addressを渡すと何の変換も無しに メモリアクセスをする単一のインストラクションへとコンパイルされるのだ。 aligned addressは常にfixnumなので、アドレス計算も非常に軽い。

ACLの低レベル関数には、addressを取るものとaligned addressを取るものが あるので、マニュアルを見るときに注意されたし。型としてはどちらもintegerなので、 間違えてもコンパイラは救ってくれない。

アドレスをどこから取ってくる?

さてアドレスが手に入ればメモリを読み書きできることはわかったが、 そのアドレスはどこから得られるだろうか。

LispオブジェクトはGCによって移動する可能性があるので、C言語の &演算子 のような気軽さでアドレスを取るわけにはいかない (実際にLispオブジェクトに 低レベルアクセスする場合はwith-pinned-objectsというマクロで 移動を制限したりと面倒がある)。

よくあるのは以下のパターン。

• 自分で管理するメモリのアドレス。aclmalloc/aclfree で、 GC対象外のメモリを管理できる (aligned address版の aclmalloc-aligned/ aclfree-alignedもある)。GCの起きるタイミングを制御したい場合とかに使う。
• Foreign function callが返すアドレス。
• ファイルや共有メモリをmmapしたアドレス。 mmapとかshared-memのAPIはACLには用意されてないけれど、 ff:def-foreign-call でOSのAPIを呼ぶことができる。

実はファイルのmmapに関しては、ACLの open に :mapped というキーワード引数が 用意されているんで、(open filename :mapped t) とするだけでファイル全体が mmapされる。帰ってきたストリームに対して (slot-value stream 'excl::buffer) とやると、mmapされたaligned addressを取ることができる。

簡単な例: zipファイルの情報を取る

具体的なコードがないとピンとこないと思うので、zipファイルをmmapして ディレクトリを読んでみよう。zipのフォーマットについては ZIP (ファイルフォーマット)あたりを参照。

まず、指定ファイルをmmapして、ストリーム、アドレス、サイズを返す関数。 なお、このストリームを閉じればメモリもmunmapされる。

(defun map-file (filename &rest flags)
  "Maps FILENAME, returns the opened stream, base aligned address and length."
  (let ((s (apply #'open filename :mapped t flags)))
    (values s (slot-value s 'excl::buffer) (file-length s))))

Zipファイル中の数値はlittle endianで、ワード境界にアラインされているとは 限らないので、sys:memrefで1バイトづつ読み出すユーティリティを作っとこう。

;; Read unaligned little-endian numbers
(defun read-u8  (base off)
  (sys:memref base off 0 :unsigned-byte))
(defun read-u16 (base off)
  (+ (sys:memref base off 0 :unsigned-byte)
     (ash (sys:memref base off 1 :unsigned-byte) 8)))
(defun read-u32 (base off)
  (+ (sys:memref base off 0 :unsigned-byte)
     (ash (sys:memref base off 1 :unsigned-byte) 8)
     (ash (sys:memref base off 2 :unsigned-byte) 16)
     (ash (sys:memref base off 3 :unsigned-byte) 24)))

もひとつ覚えとくと便利なのは「メモリ上のバイト列からLisp文字列を作る」関数 native-to-string だ。これは生アドレスを取るので、ff:aligned-to-address を使ってaligned addressから生アドレスへ変換する。

;; Fetch string from memory
(defun read-str (base off len)
  (native-to-string (+ (ff:aligned-to-address base) off) :length len))

Zipファイルのセントラルディレクトリはファイルの末尾にある。まずその終端を 見つけないとならない。ファイル末尾から遡ってマジックナンバー #x06054b50 を探す。

(defun find-end-of-central-directory (base size)
  "Find the end-of-central-directory record, returns the offset of the first
   central directory, and the number of central directory records."
  (macrolet ((search-for (byte success fail)
               `(cond ((= off 0) (error "Zip central directory not found"))
                      ((= (read-u8 base off) ,byte) (,success (- off 1)))
                      (t (,fail (- off 1))))))
    (labels ((byte1 (off) (search-for #x06 byte2 byte1))
             (byte2 (off) (search-for #x05 byte3 byte1))
             (byte3 (off) (search-for #x4b byte4 byte1))
             (byte4 (off) (search-for #x50 done byte1))
             (done (off)
               (incf off)
               (unless (= (read-u16 base (+ off 4)) 0) ; # of this disk
                 (error "Multi-disk archive isn't supported"))
               (values (read-u32 base (+ off 16))   ; offset of central directory
                       (read-u16 base (+ off 10))))) ; # of central directory recs
      (byte1 (- size 1)))))

セントラルディレクトリの一つのエントリを読み出す関数。

(defun read-central-directory-record (base off)
  "Read a central directory record at offset OFF, returns a list of next offset and infos."
  (unless (= (read-u32 base off) #x02014b50)
    (error "Corrupted central directory record at offset ~s (~x)" off (read-u32 base off)))
  (let ((version-made       (read-u16 base (+ off 4)))
        (version-required   (read-u16 base (+ off 6)))
        (compression-method (read-u16 base (+ off 10)))
        (uncompressed-size  (read-u16 base (+ off 24)))
        (filename-len       (read-u16 base (+ off 28)))
        (extra-len          (read-u16 base (+ off 30)))
        (comment-len        (read-u16 base (+ off 32))))
    (list (+ off 46 filename-len extra-len comment-len)
          (read-str base (+ off 46) filename-len)
          uncompressed-size
          (case compression-method
            (0 'uncompressed)
            (1 'unshrinking)
            ((2 3 4 5) `(expanding ,compression-method))
            (6 'imploding)
            (7 'tokenizing)
            (8 'deflating)
            (9 'enhanced-deflating)
            (12 'bzip2)
            (14 'lzma)
            (97 'wavpack)
            (98 'ppmd)
            (otherwise `(unknown ,compression-method)))
          version-made
          version-required)))

最後にこれらをまとめて呼び出せるようにしとく。

(defun parse-central-directory (base size)
  (multiple-value-bind (off count) (find-end-of-central-directory base size)
    (loop for i from 0 below count
       for (next . info) = (read-central-directory-record base off)
       collect info
       do (setf off next))))

(defun zipinfo (filename)
  (multiple-value-bind (stream base size) (map-file filename)
    (unwind-protect (parse-central-directory base size)
      (close stream))))

実行例。

cl-user> (zipinfo "src/slib-3b3.zip")
(("slib/" 0 uncompressed 798 10)
 ("slib/saturate.txt" 1852 deflating 798 20)
 ("slib/phil-spc.scm" 7351 deflating 798 20)
 ("slib/obj2str.scm" 2170 deflating 798 20)
 ("slib/arraymap.scm" 5458 deflating 798 20)
 ("slib/colorspc.scm" 17574 deflating 798 20)
 ("slib/slib.sh" 5191 deflating 798 20)
 ("slib/process.scm" 1977 deflating 798 20)
 ("slib/srfi-8.scm" 346 deflating 798 20)
 ("slib/peanosfc.txi" 942 deflating 798 20)
 ("slib/vscm.init" 14800 deflating 798 20)
 ("slib/umbscheme.init" 11246 deflating 798 20)
 ("slib/srfi.txi" 910 deflating 798 20)
 ...

コードはこちら。

まとめ

まあ、わざわざLispで低レベルコードを書きたい人ってのもそんなにいないかもしれない。 aligned addressは単なるfixnumで、まがりなりにも型がついてるC言語のポインタよりも 使い勝手悪いし。ただ、仕事で書くコードでは速度が重要なんで、こんな感じで 共有メモリにアロケータ書いたり、ファイルをmmapしてtrieやbtree構築したりしている。

今回の例みたいに読み出しだけだとありがたみが薄いかもしれないけど、 :direction :io でopenしておくとMAP_SHAREDでmmapされるんで、 (同一マシンの)複数プロセスでデータページを共有できて便利。

プロジェクト内では、 構造体を定義してオフセット取れるようにするやつとか、 posixのmutexやセマフォをラップするやつとか、 かなりのマクロやユーティリティ関数を使ってるんだけど、 そういうの無しで sys:memref だけで何かしようとするのは結構きついかも。

Gaucheにこういう機能を入れるかどうかっていうと、 低レベルまでGauche自身で書けたらおもしろいとは思うけど、 そこまで良いネイティブコードを出すことにこだわりはないので、 (fixnumをアドレスと解釈するとかではなく) メモリを表現するオブジェクトを作って、 その一部をuniform vectorとして見せるとかそんな感じになりそう。

Tags: Lisp, Programming