CRC on Scheme

先日は CRC の計算を C++ で書いた。

http://saito.hatenablog.jp/entry/2013/08/08/201105

これを書いた理由は CRC32 と CRC16 との計算速度の差を知りたかったからだ。 C++ で書いた CRC の実装を動かしてみると CRC32 の方が 6% 程度速いことがわかる。 この差は CRC32 と CRC16 とのアルゴリズム上の本質的な計算速度の差をおおよそ表していると考えていいだろう。

一方で Scheme での実装では CRC16 の方が大幅に速い。 およそ 58% もの差がついた。 理由は想像がついている。 CRC32 を計算するために 32 ビット幅の値を扱うわけだが、 Scheme 処理系に於いてはタグビットとして数ビット取られているために fixnum に収まらず、大量の数値オブジェクト (bignum) を生成してしまうからだと考えられる。 もちろん、オブジェクトの生成だけでなく、生成されたオブジェクトの操作についても fixnum と bignum ではかなり速度が違うだろう。 おそらく 64 ビット環境ではここまでの差は生じないか、逆転するのではないだろうか。

こういった場合に Scheme 上での書き方の工夫で高速化できる部分はあるかということを考えていたのだけれど、どうにも思い付かない。

とりあえず Scheme で書いた CRC のライブラリを貼り付けておく。 R7RS を想定している。

(define-library (crc)
  (export crc32 crc16)
  (import (scheme base))
  (cond-expand
   ((library (rnrs arithmetic bitwise))
    (import (rnrs arithmetic bitwise))
    (define arithmetic-shift bitwise-arithmetic-shift))
   ((library (srfi :60)) (import (srfi :60)))
   ((library (srfi 60)) (import (srfi 60)))
   ((library (srfi :33)) (import (srfi :33)))
   ((library (srfi 33)) (import (srfi 33)))
   (else (syntax-error "library (crc) is not support this Scheme implementation.")))

(begin

(define CRCPOLY32 #xedb88320)
(define CRCPOLY16 #x8408)

(define (make-crc-procedure table default)
  (lambda (data . opt)
    (bitwise-xor default
      (let ((r (get-optional opt default))
            (len (bytevector-length data)))
        (do ((i 0 (+ i 1))
             (r r
                (bitwise-xor
                 (arithmetic-shift r -8)
                 (vector-ref table
                             (bitwise-xor
                              (bitwise-and r 255)
                              (bytevector-u8-ref data i))))))
            ((= i len) r))))))

(define (make-crc-table poly)
  (let ((table (make-vector 256)))
    (do ((i 0 (+ i 1)))
        ((= i 256))
      (vector-set! table i
        (do ((j 0 (+ j 1))
             (r i
                ((if (zero? (bitwise-and r 1))
                     values
                     (lambda(x) (bitwise-xor poly x)))
                 (arithmetic-shift r -1))))
            ((= j 8) r))))
    table))

(define (get-optional rest default)
  (if (pair? rest) (car rest) default))

(define crc32 (make-crc-procedure (make-crc-table CRCPOLY32) #xffffffff))
(define crc16 (make-crc-procedure (make-crc-table CRCPOLY16) #xffff))

))

このライブラリのベンチマーク用に以下のコードを用意した。 Sagittarius か Gauche の R7RS モードで動かすことを想定している。 Gauche の場合は (リリース版ではなく) HEAD が必要なので注意されたい。

(import (scheme base)
        (crc))

(cond-expand
 ((library (rfc zlib))
  (import (prefix (rfc zlib) zlib:))))

(cond-expand
 (gauche (import (gauche time)))
 (sagittarius (import (time)))
 (else (define time values)))

(define data (make-bytevector (* 1024 1024 200) 80))

(cond-expand
 ((and (library (rfc zlib)) (or gauche sagittarius))
  (time (zlib:crc32 data))))

(time (crc32 data))
(time (crc16 data))

Document ID: b0c108a1b054f390c5e6653234c2dc20