Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2011-05-14

(どうでも良い)SBCLクイズ: 空ループの最適化 回答

| 20:27 | (どうでも良い)SBCLクイズ: 空ループの最適化 回答 - わだばLisperになる を含むブックマーク はてなブックマーク - (どうでも良い)SBCLクイズ: 空ループの最適化 回答 - わだばLisperになる

先日の(どうでも良い)SBCLクイズ: 空ループの最適化でしたが、最適化だけに最適化のレベルによって変ってくるようで環境によってはfoo-slowもfoo-fastも同じ、ということになるようです。

なるほど、すっかり設定に依存するということが頭から抜けていました…。

ということで、とりあえずここでは、(proclaim '(optimize (compilation-speed 0) (debug 3) (safety 0) (space 3) (speed 3)))のようなアグレッシブな設定で行く、ということにします。

それで回答ですが、自分は色々調べたり試してみたりして、最初に下のようなものを書きました

(defun foo-fast ()
  (let* ((numbers (coerce (- 0 1) 'number))
         (numbers (+ numbers (coerce 1 'number))))
    (declare (type number numbers))
    (tagbody
      LL
      (if (> numbers (* 10000 10000))
          (go END))
      (setq numbers (+ numbers (coerce 1 'number)))
      (go LL)
      END)
    nil))
(foo-fast)
;⇒ NIL
----------
Evaluation took:
  0.051 seconds of real time
  0.050000 seconds of total run time (0.050000 user, 0.000000 system)
  98.04% CPU
  120,854,475 processor cycles
  0 bytes consed

Intel(R) Core(TM)2 Duo CPU     P8600  @ 2.40GHz
; disassembly for FOO-FAST
; 19C6CAF4:       31C9             XOR ECX, ECX               ; no-arg-parsing entry point
;      AF6:       EB0C             JMP L1
;      AF8:       90               NOP
;      AF9:       90               NOP
;      AFA:       90               NOP
;      AFB:       90               NOP
;      AFC:       90               NOP
;      AFD:       90               NOP
;      AFE:       90               NOP
;      AFF:       90               NOP
;      B00: L0:   4883C108         ADD RCX, 8
;      B04: L1:   4881F90008AF2F   CMP RCX, 800000000
;      B0B:       7EF3             JLE L0
;      B0D:       BA17001020       MOV EDX, 537919511
;      B12:       488BE5           MOV RSP, RBP
;      B15:       F8               CLC
;      B16:       5D               POP RBP
;      B17:       C3               RET
;      B18:       CC0A             BREAK 10                   ; error trap
;      B1A:       02               BYTE #X02
;      B1B:       18               BYTE #X18                  ; INVALID-ARG-COUNT-ERROR
;      B1C:       54               BYTE #X54                  ; RCX

これをDISASSEMBLEしてもカウンターの部分でCLの関数の+は使われず、

L0:   ADD RCX, 8
L1:   CMP RCX, 800000000
      JLE L0

のようにひたすらカウントアップしているのが分かります。

それで結局何が違うのかというと、SETQの位置が違うだけでFOO-SLOWは、

(defun foo-slow ()
  (let* ((numbers (coerce (- 0 1) 'number)))
    (declare (type number numbers))
    (tagbody
      LL
      (setq numbers (+ numbers (coerce 1 'number)))
      (if (> numbers (* 10000 10000))
          (go END))
      (go LL)
      END)
    nil))

IFの前にSETQがあるだけ、ということになります。

何が違ってくるのかは、結局のところ全然自分も追い切れていないのですが、どうもSB-C::MAYBE-INFER-ITERATION-VAR-TYPEという関数があって、コンパイル時に中身を走査して繰り返し用の変数をみつけたら最適化する、ということをやっているようです。

(例えば、(setq foo (+ foo x))のような形の場合fooは繰り返しのカウンターの可能性が高い、等々)

また、最初の回答以外にも繰り返し用の変数をFIXNUMにすることでも大体同じ結果になるようです。

(defun foo-fast ()
  (let* ((numbers (coerce (- 0 1) 'fixnum)))
    (declare (type fixnum numbers))
    (tagbody
      LL
      (setq numbers (+ numbers 1))
      (if (> numbers (* 10000 10000))
          (go END))
      (go LL)
      END)
    nil))

この場合は、どうやら上の最適化に加え、繰り返しの演算がFIXNUMになることによって高速化される、という微妙に別のルートの最適化のようです。

  • SETQを最適化しやすい位置に置く
L0:   ADD RCX, 8
L1    CMP RCX, 800000000
      JLE L0
  • 繰り返し変数をFIXNUMにする
L0:    ADD RCX, 8
       MOV RDX, RCX
       CMP RDX, 800000000
       JLE L0

以上、とりとめなく書き散らかしてしまいましたが、どうしてこの最適化をみつけたかというと、SBCLのLOOPの展開形と比較した際にSETQの位置しか違わなかった、というのがきっかけでした。

これ以外にも、知らないところで知らない機能が発動して最適化していることって結構あるんでしょうねー。

2011-05-07

(どうでも良い)SBCLクイズ: 空ループの最適化

| 17:04 | (どうでも良い)SBCLクイズ: 空ループの最適化 - わだばLisperになる を含むブックマーク はてなブックマーク - (どうでも良い)SBCLクイズ: 空ループの最適化 - わだばLisperになる

(defun foo-slow ()
  (let* ((numbers (coerce (- 0 1) 'number)))
    (declare (type number numbers))
    (tagbody
      LL
      (setq numbers (+ numbers (coerce 1 'number)))
      (if (> numbers (* 10000 10000))
          (go END))
      (go LL)
      END)
    nil))

というコードがあります。

これは、Series

(collect-ignore (scan-range :from 0 :upto (* 10000 10000)))

マクロの展開結果で、単に空のループを1億回実行するというものですが、実行スピードが LOOP マクロの同等のコードより10倍位遅いのが悔しいので、同じ位高速なfoo-fastを作成してください、というのが問題です。

実行速度

(foo-slow)
;⇒ NIL
----------
Evaluation took:
  0.520 seconds of real time
  0.520000 seconds of total run time (0.520000 user, 0.000000 system)
  100.00% CPU
  1,242,649,269 processor cycles
  0 bytes consed

Intel(R) Core(TM)2 Duo CPU     P8600  @ 2.40GHz
(defun bar-fast ()
  (loop :repeat (* 10000 10000)))

(bar-fast)
;⇒ NIL
----------
Evaluation took:
  0.045 seconds of real time
  0.040000 seconds of total run time (0.040000 user, 0.000000 system)
  88.89% CPU
  106,853,454 processor cycles
  0 bytes consed

Intel(R) Core(TM)2 Duo CPU     P8600  @ 2.40GHz

foo-slowのDISASSEMBLEの結果は、

; disassembly for FOO-SLOW
; 18029EF4:       48C7C3F8FFFFFF   MOV RBX, -8                ; no-arg-parsing entry point
;      EFB:       90               NOP
;      EFC:       90               NOP
;      EFD:       90               NOP
;      EFE:       90               NOP
;      EFF:       90               NOP
;      F00: L0:   BF08000000       MOV EDI, 8
;      F05:       488BD3           MOV RDX, RBX
;      F08:       4C8D1C25E0010020 LEA R11, [#x200001E0]      ; GENERIC-+
;      F10:       41FFD3           CALL R11
;      F13:       480F42E3         CMOVB RSP, RBX
;      F17:       488BDA           MOV RBX, RDX
;      F1A:       48895DF8         MOV [RBP-8], RBX
;      F1E:       BF0008AF2F       MOV EDI, 800000000
;      F23:       488BD3           MOV RDX, RBX
;      F26:       488D0C2544040020 LEA RCX, [#x20000444]      ; GENERIC->
;      F2E:       FFD1             CALL RCX
;      F30:       488B5DF8         MOV RBX, [RBP-8]
;      F34:       7ECA             JLE L0
;      F36:       BA17001020       MOV EDX, 537919511
;      F3B:       488BE5           MOV RSP, RBP
;      F3E:       F8               CLC
;      F3F:       5D               POP RBP
;      F40:       C3               RET
;      F41:       CC0A             BREAK 10                   ; error trap
;      F43:       02               BYTE #X02
;      F44:       18               BYTE #X18                  ; INVALID-ARG-COUNT-ERROR
;      F45:       54               BYTE #X54                  ; RCX

ですが、bar-fastのDISASSEMBLE結果は、

; disassembly for BAR-FAST
; 19357284:       B90008AF2F       MOV ECX, 800000000         ; no-arg-parsing entry point
;       89:       EB09             JMP L1
;       8B:       90               NOP
;       8C:       90               NOP
;       8D:       90               NOP
;       8E:       90               NOP
;       8F:       90               NOP
;       90: L0:   4883E908         SUB RCX, 8
;       94: L1:   4883F900         CMP RCX, 0
;       98:       7FF6             JNLE L0
;       9A:       BA17001020       MOV EDX, 537919511
;       9F:       488BE5           MOV RSP, RBP
;       A2:       F8               CLC
;       A3:       5D               POP RBP
;       A4:       C3               RET
;       A5:       CC0A             BREAK 10                   ; error trap
;       A7:       02               BYTE #X02
;       A8:       18               BYTE #X18                  ; INVALID-ARG-COUNT-ERROR
;       A9:       54               BYTE #X54                  ; RCX
;       AA:       CC0A             BREAK 10                   ; error trap
;       AC:       02               BYTE #X02
;       AD:       18               BYTE #X18                  ; INVALID-ARG-COUNT-ERROR
;       AE:       54               BYTE #X54                  ; RCX

です。foo-fastは

; disassembly for FOO-FAST
; 18229894:       31C9             XOR ECX, ECX               ; no-arg-parsing entry point
;       96:       EB0C             JMP L1
;       98:       90               NOP
;       99:       90               NOP
;       9A:       90               NOP
;       9B:       90               NOP
;       9C:       90               NOP
;       9D:       90               NOP
;       9E:       90               NOP
;       9F:       90               NOP
;       A0: L0:   4883C108         ADD RCX, 8
;       A4: L1:   4881F90008AF2F   CMP RCX, 800000000
;       AB:       7EF3             JLE L0
;       AD:       BA17001020       MOV EDX, 537919511
;       B2:       488BE5           MOV RSP, RBP
;       B5:       F8               CLC
;       B6:       5D               POP RBP
;       B7:       C3               RET
;       B8:       CC0A             BREAK 10                   ; error trap
;       BA:       02               BYTE #X02
;       BB:       18               BYTE #X18                  ; INVALID-ARG-COUNT-ERROR
;       BC:       54               BYTE #X54                  ; RCX

のようなものになると思われます。

2009-10-11

祝SBCL 10周年と受け継がれるコード

| 01:45 | 祝SBCL 10周年と受け継がれるコード - わだばLisperになる を含むブックマーク はてなブックマーク - 祝SBCL 10周年と受け継がれるコード - わだばLisperになる

SBCLのプロジェクトが開始されてから十周年だそうで、記念にワークショップが開かれるようです。

SBCLはCMUCLが元になっていることは良く知られていると思いますが、CMUCLも元を辿るとSpice Lispを起源としています。

そのSpice Lispは、元々1980年位にCMUのSpiceプロジェクトで開発されていたMacLISP系のLISPだったようですが、丁度、同じ頃Common Lispも策定が開始していて、CLtL1が出た(1984年3月)頃には、

マニュアルの中で

Spice Lisp is the implemantaion of the Common Lisp
for microcodable personal machine running CMU's
Spice computing environment.

と説明されていますので、いつの間にやらCLになっていたようです。

現在、Spice Lispのソースコードはネット上には見当たらないのですが、Spice Lispから枝分かれした、PDP-20上で動くRutgers Common Lispのソースは公開されています。

これを眺めていると気付くと思うのですが、現在のSBCLにも使われているコードが結構あります。

例えば、リスト系の関数定義、list.lispを眺めてみると(同じファイル名)

;; SBCL
(defun revappend (x y)
  #!+sb-doc
  "Return (append (reverse x) y)."
  (do ((top x (cdr top))
       (result y (cons (car top) result)))
      ((endp top) result)))

;; Spice Lisp (TOPS-20 Common Lisp)
(defun revappend (x y)
  "Returns (append (reverse x) y)"
  (do ((top x (cdr top))
       (result y (cons (car top) result)))
      ((atom top) result)))

のように、殆ど同じ定義だったりします。(リスト系の関数ということもあるのでしょうが…)

というわけで、SBCLは10周年ですが、Common Lispの歴史と同じか、それより古いコードが元になっていたりもするようです。

ちなみに、LispマシンがあったMITではLOOPマクロが好んで使われていたようなのですが、CMUではLOOPは使われていなかったらしく、このlist.lispでも嫌になる程DOが多用されています。

考えつく限りの方法でDOが使い倒されているので、Spice Lisp由来のコードはDO好きにはまさにバイブル的存在といえましょう…。

2007-12-28

SBCL 1.0.13リリース

| 01:36 | SBCL 1.0.13リリース - わだばLisperになる を含むブックマーク はてなブックマーク - SBCL 1.0.13リリース - わだばLisperになる

SBCLは大体毎月25日にリリースされるんでしょうか、今月も27日に新バージョンがリリースされました。

リリースノートなどは普段全く読みませんが、たまたま読んでみたら、run-programの動作が強化されたということで、

enhancement: RUN-PROGRAM allows unicode arguments and 
environments to be used (using the default stream external
 format), and allows non-simple strings to be used.
(thanks to Harald Hanche-Olsen)

とのこと。これまた、たまたまですが、昨日PLEACの問題を書いているときに

(let ((output 
       (with-output-to-string (out)
	 (sb-ext:run-program "date" '() 
			     :output out
			     :search '("/bin" "/usr/bin")
			     :environment '("LANG=ja_JP.utf-8")))))
  (princ output))

というものの出力が、

2007年 12月 29日 土曜日 00:58:28 JST

となってしまい、うーん、と思っていました。

1.0.13で試してみると、

2007年 12月 29日 土曜日 00:54:24 JST

とエンコードが合っていればきちんと表示されます。(例はUTF-8で揃えています)

この辺は、KMRCLでは問題なかったので、PLEACではKMRCLを使いました。(まあ、処理系依存度が低くなるので、KMRCLを使ったほうが良いとは思います…)

それで、全然脈絡はありませんが、SBCLのソースからのビルド、普段使っているイメージの作成までの記録をつけて置くことにしてみました。

以下メモです。

  1. ソース取得

$ wget http://nchc.dl.sourceforge.net/sourceforge/sbcl/sbcl-1.0.13-source.tar.bz2

  1. 解凍

$ tar jxvf sbcl-1.0.13-source.tar.bz2

  1. マルチスレッドで使いたいのでカスタマイズファイルcustomize-target-featuresに記述

$ cat ./customize-target-features.lisp

(lambda (features)
      (flet ((enable (x)
               (pushnew x features))
             (disable (x)
               (setf features (remove x features))))
        ;; Threading support, available only on x86/x86-64 Linux, x86 Solaris
        ;; and x86 Mac OS X (experimental).
        (enable :sb-thread)))
  1. ビルド

$ cat ./sbclcompr

#!/bin/sh

SBCL_HOME=/usr/local/sbcl/1.0.12/lib/sbcl /usr/local/sbcl/1.0.12/bin/sbcl $*

$ sh make.sh "./sbclcompr"

  1. ビルド後のテスト

$ cd tests && sh ./run-tests.sh

  1. ドキュメントをビルド

$ cd doc/manual && make

  1. インストール

$ INSTALL_ROOT=/usr/local/sbcl/1.0.13 sh ./install.sh