mojavy.com

Common Lispのdeclareについて

November 09, 2012 at 11:00 PM | categories: common lisp |

lisp

Common Lispのdeclareについて調べた。 変数の型や式に関することをコンパイラに伝えてやるために使うものらしい。

例えば、

(defun add (x y) (+ x y))

(defun add (x y)
  (declare (fixnum x y))
  (the fixnum (+ x y)))

とすれば、引数と戻り値の型を指定できる。

さらに、

(defun add (x y)
  (declare (optimize (speed 3) (safety 0)))
  (declare (fixnum x y))
  (the fixnum (+ x y)))

とすればさらに最適化される。ここまですると、Cで実装した場合と遜色ないくらいになるらしい。

ためしにdisassembleしてみた。処理系はsbcl 1.0.55.0。

最初のバージョンは以下のようになった。すでにある程度最適化されてる? LEA(load effective address)命令は、srcオペランドのアドレスを計算し、そのアドレスをdestオペランドにロードするというものらしい。(参考)

CL-USER> (defun add (x y) (+ x y))

CL-USER> (disassemble #'add)
; disassembly for ADD
; 03C43D5D:       488B55F8         MOV RDX, [RBP-8]           ; no-arg-parsing entry point
;       61:       488B7DF0         MOV RDI, [RBP-16]
;       65:       4C8D1C25E0010020 LEA R11, [#x200001E0]      ; GENERIC-+
;       6D:       41FFD3           CALL R11
;       70:       480F42E3         CMOVB RSP, RBX
;       74:       488BE5           MOV RSP, RBP
;       77:       F8               CLC
;       78:       5D               POP RBP
;       79:       C3               RET
;       7A:       CC0A             BREAK 10                   ; error trap
;       7C:       02               BYTE #X02
;       7D:       18               BYTE #X18                  ; INVALID-ARG-COUNT-ERROR
;       7E:       54               BYTE #X54                  ; RCX

2番目の、型だけを宣言したものは以下のようになった。うーむ、確かに型チェックっぽいコードは増えてるが速くなってるわけではなさそうな感じ。あとで調べる。

CL-USER> (defun add (x y)
           (declare (fixnum x y))
           (the fixnum (+ x y)))

CL-USER> (disassemble #'add)
; disassembly for ADD
; 039D3B73:       488BD1           MOV RDX, RCX               ; no-arg-parsing entry point
;       76:       48D1FA           SAR RDX, 1
;       79:       488BC7           MOV RAX, RDI
;       7C:       48D1F8           SAR RAX, 1
;       7F:       4801C2           ADD RDX, RAX
;       82:       48B80000000000000040 MOV RAX, 4611686018427387904
;       8C:       4801D0           ADD RAX, RDX
;       8F:       48C1E83F         SHR RAX, 63
;       93:       7509             JNE L0
;       95:       48D1E2           SHL RDX, 1
;       98:       488BE5           MOV RSP, RBP
;       9B:       F8               CLC
;       9C:       5D               POP RBP
;       9D:       C3               RET
;       9E: L0:   486BC202         IMUL RAX, RDX, 2
;       A2:       710E             JNO L1
;       A4:       488BC2           MOV RAX, RDX
;       A7:       4C8D1C25B0050020 LEA R11, [#x200005B0]      ; ALLOC-SIGNED-BIGNUM-IN-RAX
;       AF:       41FFD3           CALL R11
;       B2: L1:   488B1557FFFFFF   MOV RDX, [RIP-169]         ; 'FIXNUM
;       B9:       CC0A             BREAK 10                   ; error trap
;       BB:       03               BYTE #X03
;       BC:       1F               BYTE #X1F                  ; OBJECT-NOT-TYPE-ERROR
;       BD:       15               BYTE #X15                  ; RAX
;       BE:       95               BYTE #X95                  ; RDX
;       BF:       CC0A             BREAK 10                   ; error trap
;       C1:       02               BYTE #X02
;       C2:       18               BYTE #X18                  ; INVALID-ARG-COUNT-ERROR
;       C3:       54               BYTE #X54                  ; RCX
;       C4:       CC0A             BREAK 10                   ; error trap
;       C6:       02               BYTE #X02
;       C7:       08               BYTE #X08                  ; OBJECT-NOT-FIXNUM-ERROR
;       C8:       95               BYTE #X95                  ; RDX
;       C9:       CC0A             BREAK 10                   ; error trap
;       CB:       04               BYTE #X04
;       CC:       08               BYTE #X08                  ; OBJECT-NOT-FIXNUM-ERROR
;       CD:       FED501           BYTE #XFE, #XD5, #X01      ; RDI

最後の最適化の宣言をつけたものは以下のようになった。たしかに速そうにはなった。

CL-USER> (defun add (x y)
           (declare (optimize (speed 3) (safety 0)))
           (declare (fixnum x y))
           (the fixnum (+ x y)))

CL-USER> (disassemble #'add)
; disassembly for ADD
; 034DD10F:       4801FA           ADD RDX, RDI               ; no-arg-parsing entry point
;       12:       488BE5           MOV RSP, RBP
;       15:       F8               CLC
;       16:       5D               POP RBP
;       17:       C3               RET

ついでにCで書いた以下の関数もdisassebleしてみた。

int add(int x, int y) {
    return x + y;
}

cc -c a.c && objdump -d a.o とすると、

a.o:     file format elf64-x86-64

Disassembly of section .text:

0000000000000000 <add>:
   0:   55                      push   %rbp
   1:   48 89 e5                mov    %rsp,%rbp
   4:   89 7d fc                mov    %edi,-0x4(%rbp)
   7:   89 75 f8                mov    %esi,-0x8(%rbp)
   a:   8b 45 f8                mov    -0x8(%rbp),%eax
   d:   8b 55 fc                mov    -0x4(%rbp),%edx
  10:   01 d0                   add    %edx,%eax
  12:   5d                      pop    %rbp
  13:   c3                      retq

cc -O3 -c a.c && objdump -d a.o なら、

a.o:     file format elf64-x86-64

Disassembly of section .text:

0000000000000000 <add>:
   0:   8d 04 37                lea    (%rdi,%rsi,1),%eax
   3:   c3                      retq

まあとりあえず単純に命令数だけでいうと、 素のSBCL > 素のGCC > 最適化したSBCL > 最適化したGCC という感じにはなったので、CよりLispのほうが速い(場合もある)というふれこみは嘘ではなさそうですね。



Common Lisp練習 - CodeChef : TSORT

October 24, 2012 at 06:00 PM | categories: programming, common lisp |

codechef

Common Lispの練習にCodeChefの↓の練習問題をやってみた。

http://www.codechef.com/problems/TSORT

問題自体は全然難しくないけど、Common Lispで解こうとしたらTime Limit Exceededでおちてしまった。

最初は以下のように書いて、

(let ((_n (parse-integer (read-line)))
      (lis ()))
  (dotimes (i _n)
    (push (parse-integer (read-line)) lis))
  (setf lis (sort lis #'(lambda (x y) (< x y))))
  (dolist (x lis) (format t "~a~%" x)))

以下の用にして時間を測ったところ

$ time ruby -e 'n=1000000;puts n; n.times{puts (rand * 10000000).to_i}' | sbcl --script turbosort.cl > /dev/null
ruby -e 'n=1000000;puts n; n.times{puts (rand * 10000000).to_i}'  1.19s user 0.01s system 91% cpu 1.311 total
sbcl --script turbosort.cl > /dev/null  3.42s user 0.43s system 97% cpu 3.938 total

ローカルだと3.42s程度だった。codechef上での制限は5secなのでセーフかと思ったけどTime Limit Exceededだった。

そこで、vectorを使うように改良

(let* ((_n (parse-integer (read-line)))
       (lis (make-array _n :fill-pointer 0)))
  (dotimes (i _n)
    (vector-push (parse-integer (read-line)) lis))
  (setf lis (sort lis #'(lambda (x y) (< x y))))
  (loop for i across lis do (format t "~a~%" i)))
$ time ruby -e 'n=1000000;puts n; n.times{puts (rand * 10000000).to_i}' | sbcl --script turbosort.cl > /dev/null
ruby -e 'n=1000000;puts n; n.times{puts (rand * 10000000).to_i}'  1.21s user 0.01s system 94% cpu 1.289 total
sbcl --script turbosort.cl > /dev/null  2.64s user 0.44s system 98% cpu 3.137 total

若干改善されたが、まだTime Limit Exceededだった。

read-sequenceで読み込んだほうが早いかと思って以下のように書いてみた。

(defun parse-input (str)
  (loop
     for i = 0 then (+ 1 j)
     as j = (position #\Newline str :start i)
     as k = (parse-integer (subseq str i j) :junk-allowed t)
     if (not (null k))
     collect k
     while j))

(let* ((_n (parse-integer (read-line)))
       (lis (make-array (* _n 20) :element-type 'character))
       (nums ())
       )
  (read-sequence lis *standard-input*)
  (setf nums (sort (parse-input lis) #'(lambda (x y) (< x y))))
  (loop for i in nums do (format t "~a~%" i)))
$ time ruby -e 'n=1000000;puts n; n.times{puts (rand * 10000000).to_i}' | sbcl --script turbosort.cl > /dev/null
ruby -e 'n=1000000;puts n; n.times{puts (rand * 10000000).to_i}'  1.13s user 0.01s system 97% cpu 1.159 total
sbcl --script turbosort.cl > /dev/null  3.67s user 0.48s system 96% cpu 4.297 total

残念ながら逆に遅くなってしまった。parse-inputの部分で60%くらい時間がかかっていた。 あと、#'(lambda (x y) (< x y))の部分を #'<にするとなぜか遅くなる。

まだ誰もlispではパスしてない模様。こういうのをもっと高速に書く方法あるのだろうか。

ちなみにCだと余裕。ローカルだと0.2秒くらいだけどリモートでは3秒くらいかかってた。そもそもCodeChefの実行環境がしょぼすぎる疑惑が。。

#include <stdio.h>
#include <stdlib.h>

int f(const void *i, const void *j) {
    return *((int*)i) > *((int*)j);
}

int main(void) {
    char buf[256];
    int num = atoi(fgets(buf, 256, stdin));

    int lis[num];
    for (int i = 0; i < num; ++i) {
        lis[i] = atoi(fgets(buf, 256, stdin));
    }
    qsort(lis, num, sizeof(int), f);
    for (int i = 0; i < num; ++i) {
        printf("%d\n", lis[i]);
    }
$ time ruby -e 'n=1000000;puts n; n.times{puts (rand * 10000000).to_i}' | ./a.out > /dev/null
ruby -e 'n=1000000;puts n; n.times{puts (rand * 10000000).to_i}'  0.99s user 0.01s system 99% cpu 1.006 total
./a.out > /dev/null  0.18s user 0.01s system 17% cpu 1.116 total


iOSでZeroMQを試す

October 18, 2012 at 06:00 PM | categories: objective-c, ios, zeromq, common lisp |

zeromq

前回Common LispでZeroMQを試してみたが、今度はiOSからも試してみた。ZeroMQのライセンスはLGPLだが、static linking exceptionがあるのでiPhoneアプリに組み込んでもソースは公開しなくて大丈夫なはず。(勘違いしてたらごめんなさい)

ZeroMQをiPhone用にビルド

ZeroMQはautotoolsで作成されておりconfigure && make でビルドできるようになっているが、iPhone用にクロスコンパイルをするためには適切なオプションを与えてやる必要がある。

一応、本家サイト上にもドキュメントはあるが最新のXcodeではうごかない。また、シミュレータ用でもうごかせるようにしておきたい。というわけで、以下のようなビルドスクリプトを書いた。

これをZeroMQのtarを展開してできたディレクトリにbuild.shとかで保存して実行すると、armv7とi386に対応したlibzmq.aができる。

$ tar xzf zeromq-2.2.0.tar.gz
$ cd zeromq-2.2.0
$ ./build.sh
$ file libzmq.a
libzmq.a: Mach-O universal binary with 2 architectures
libzmq.a (for architecture armv7):      current ar archive random library
libzmq.a (for architecture i386):       current ar archive random library

このlibzmq.aと、includeディレクトリの中身をXcodeにインポートしてやればよい。 このときに、XcodeでOther Linker Flags に -lstdc++ を追加してやるのを忘れないように。

ZeroMQを用いた簡易チャットアプリ

サンプルとしてチャットアプリを実装してみる。 チャットでの発言はREQ/REPを用いてアプリ→サーバに渡し、PUB/SUBを用いてサーバ→アプリにブロードキャストする。

サーバ側

サーバ側はCommon Lispで実装した。単に、rep-sockから発言を受け取ってpub-sockにそのまま流すだけ。

(load "~/.sbclrc")
(ql:quickload :zeromq)

(defun pull-and-publish ()
  (zmq:with-context (ctx 1)
    (zmq:with-socket (rep-sock ctx zmq:rep)
      (zmq:bind rep-sock "tcp://127.0.0.1:5555")

      (zmq:with-context (ctx2 1)
        (zmq:with-socket (pub-sock ctx2 zmq:pub)
          (zmq:bind pub-sock "tcp://127.0.0.1:5556")

          (loop
             (let ((msg (make-instance 'zmq:msg)))
               (zmq:recv rep-sock msg)
               (zmq:send rep-sock (make-instance 'zmq:msg :data "ok"))
               (zmq:send pub-sock msg))))))))

(pull-and-publish)

REQ/REPではなくPULL/PUSHでもできるはずだが、なぜかcl-zmqではpullがつかえなかったのでREQ/REPをつかった。

アプリ側

objective-c版ZeroMQもあるけど、今回はそのままCのAPIを利用した。 以下はソースの抜粋。

#import "ChatViewController.h"
#import "include/zmq.h"

@interface ChatViewController () {

    void *ctx1, *ctx2;
    void *subsock, *reqsock;

    NSMutableArray *messageList;
}
@end

@implementation ChatViewController

@synthesize nickname;
@synthesize timer;

- (void)viewDidLoad
{
    [super viewDidLoad];

    ctx1 = zmq_init(1);
    subsock = zmq_socket(ctx1, ZMQ_SUB);
    zmq_setsockopt(subsock, ZMQ_SUBSCRIBE, "", 0);
    int rc = zmq_connect(subsock, "tcp://127.0.0.1:5556");
    assert(rc == 0);

    ctx2 = zmq_init(1);
    reqsock = zmq_socket(ctx1, ZMQ_REQ);
    rc = zmq_connect(reqsock, "tcp://127.0.0.1:5555");
    assert(rc == 0);

    self.timer = [NSTimer scheduledTimerWithTimeInterval:1 target:self selector:@selector(observeSocket) userInfo:nil repeats:YES];
    messageList = [[NSMutableArray alloc] init];
}

- (void)viewWillDisappear:(BOOL)animated
{
    [self.timer invalidate];
    zmq_close(subsock);
    zmq_close(reqsock);
    zmq_term(ctx1);
    zmq_term(ctx2);
}

- (void)observeSocket
{
    zmq_msg_t msg;
    int rc = zmq_msg_init(&msg);
    assert(rc == 0);

    do {
        rc = zmq_recv(subsock, &msg, ZMQ_NOBLOCK);
        if (rc == EAGAIN) {
            NSLog(@"no data available");
        } else if (rc == ENOTSUP) {
            NSLog(@"ENOTSUP");
        } else if (rc == EFSM) {
            NSLog(@"EFSM");
        } else if (rc == ETERM) {
            NSLog(@"ETERM");
        } else if (rc == ENOTSOCK) {
            NSLog(@"ENOTSOCK");
        } else if (rc == EINTR) {
            NSLog(@"EINTR");
        } else if (rc == EFAULT) {
            NSLog(@"EFAULT");
        } else if (rc == 0) {
            size_t siz = zmq_msg_size(&msg);
            void *dat = zmq_msg_data(&msg);
            NSString *str = [[NSString alloc] initWithData:[NSData dataWithBytes:dat length:siz] encoding:NSUTF8StringEncoding];
            [messageList insertObject:str atIndex:0];
        } else {
            NSLog(@"unknown");
        }
    } while (rc == 0);
    zmq_msg_close(&msg);
    [self.tableView reloadData];
}

- (IBAction) saySomething:(id)sender
{
    UIAlertView *alert = [[UIAlertView alloc] initWithTitle:@"text input"
                                message:@""
                               delegate:self
                      cancelButtonTitle:@"cancel"
                      otherButtonTitles:@"ok", nil];
    alert.alertViewStyle = UIAlertViewStylePlainTextInput;
    [alert show];
}

- (void)alertView:(UIAlertView*)alertView clickedButtonAtIndex:(NSInteger)buttonIndex
{
    zmq_msg_t msg;
    int rc;
    NSData *data;
    NSString *str;

    switch (buttonIndex) {
        case 0:
            break;
        case 1:
            str = [NSString stringWithFormat:@"%@: %@", nickname, [alertView textFieldAtIndex:0].text];
            data = [str dataUsingEncoding:NSUTF8StringEncoding];
            rc = zmq_msg_init_size(&msg, [data length]);
            assert(rc == 0);
            memcpy(zmq_msg_data(&msg), [data bytes], [data length]);

            zmq_send(reqsock, &msg, 0);
            zmq_recv(reqsock, &msg, 0);
            zmq_msg_close(&msg);
            break;
        default:
            break;
    }
}

@end

以下補足

  • 簡単のためタイマーで1秒ごとにソケットにメッセージがあるかどうかobserveSocketでチェックしているが、別スレッドにしたほうがスマート
  • zmq_recvのマニュアルによると、zmq_recvをZMQ_NOBLOCKで呼んだときにメッセージがなかった場合はEAGAINが返るとなっているが、-1がかえってきていた。
  • 上記ソースはUITableViewControllerで発言を表示する想定になっているが、UIまわりのコードは省略

オマケ(Common Lisp版コマンドライン用チャットクライアント)

(load "~/.sbclrc")
(ql:quickload :zeromq)
(ql:quickload :bordeaux-threads)

(defun sub ()
  (zmq:with-context (ctx 1)
    (zmq:with-socket (socket ctx zmq:sub)
      (zmq:setsockopt socket zmq:subscribe "")
      (zmq:connect socket "tcp://127.0.0.1:5556")
      (loop
         (let ((query (make-instance 'zmq:msg)))
           (zmq:recv socket query)
           (format t "received message: ~a~%" (zmq:msg-data-as-string query)))))))

(defun client ()
  (zmq:with-context (ctx 1)
    (zmq:with-socket (socket ctx zmq:req)
      (zmq:connect socket "tcp://127.0.0.1:5555")
      (loop
         (zmq:send socket (make-instance 'zmq:msg
                                         :data (read-line)))
         (let ((result (make-instance 'zmq:msg)))
           (zmq:recv socket result))))))

(bordeaux-threads:make-thread #'sub)
(client)

まとめ

  • iPhoneでZeroMQを動かしてみた
  • ZeroMQのREQ/REPとPUB/SUBを使用してチャットをつくってみた
  • appleの審査を通過するかどうかは知らない(一応実績はあるらしい)

参考



Common LispでZeroMQを試す

October 17, 2012 at 12:00 AM | categories: zeromq, sbcl, common lisp |

zeromq

Common LispでZeroMQを試してみた。

使用環境は以下のとおり

1. quicklispのインストール

以下を参考にquicklispをインストールする。

$ curl -O http://beta.quicklisp.org/quicklisp.lisp
$ sbcl
(load "quicklisp.lisp")
(quicklisp-quickstart:install :path ".quicklisp/")
(ql:add-to-init-file)

※ (quicklisp-quickstart:install :path ".quicklisp/") のパスで最後のスラッシュは省略不可

2. cl-zmqのインストール

(ql:quickload :zeromq)

ここで以下のようなエラーがでる場合はzeromqのインストールができていないか、ld.so.confに問題がある。ld.so.confにzeromqをインストールしたディレクトリがはいってることを確認して、sudo ldconfig すればちゃんとロードされるはず。

debugger invoked on a LOAD-FOREIGN-LIBRARY-ERROR in thread
#<THREAD "initial thread" RUNNING {10029990A3}>:
  Unable to load any of the alternatives:
   ("libzmq.so.0.0.0" "libzmq.so")

Type HELP for debugger help, or (SB-EXT:QUIT) to exit from SBCL.

restarts (invokable by number or by possibly-abbreviated name):
  0: [RETRY          ] Try loading the foreign library again.
  1: [USE-VALUE      ] Use another library instead.
  2: [TRY-RECOMPILING] Recompile package and try loading it again
  3: [RETRY          ] Retry
                       loading FASL for #<CL-SOURCE-FILE "zeromq" "package">.
  4: [ACCEPT         ] Continue, treating
                       loading FASL for #<CL-SOURCE-FILE "zeromq" "package"> as
                       having been successful.
  5: [ABORT          ] Give up on "zeromq"
  6:                   Exit debugger, returning to top level.

(CFFI::FL-ERROR
 "Unable to load any of the alternatives:~%   ~S"
 ("libzmq.so.0.0.0" "libzmq.so"))
0] 2

以下のようにしてライブラリのパスを設定してやっても回避はできるがおすすめしない。

(pushnew "/path/to/lib/" *foreign-library-directories*)

http://common-lisp.net/project/cffi/manual/html_node/_002aforeign_002dlibrary_002ddirectories_002a.html

3. サーバ側起動

cl-zmq のサンプルコード参考に以下のようなエコーサーバを書いた。これをserver.lispに保存して、 sbcl --script server.lisp で実行。ちなみに、127.0.0.1:5555 の部分をlocalhost:5555のように書くとNo such deviceといわれる。 (参考 Why doesn't zeromq work on localhost? )

(load "~/.sbclrc")
(ql:quickload :zeromq)

(defun server ()
  (zmq:with-context (ctx 1)
    (zmq:with-socket (socket ctx zmq:rep)
      (zmq:bind socket "tcp://127.0.0.1:5555")
      (loop
         (let ((query (make-instance 'zmq:msg)))
           (zmq:recv socket query)
           (let ((req-string (zmq:msg-data-as-string query)))
             (format t "Recieved message: '~A'~%" req-string)
             (zmq:send socket (make-instance 'zmq:msg :data req-string)) ))))))

(server)

4. クライアント側起動

こちらも同様に以下をclient.lispに保存して、sbcl --script client.lispで実行。うまくいけばサーバ側からレスポンスが返ってくる。

(load "~/.sbclrc")
(ql:quickload :zeromq)

(defun client ()
  (zmq:with-context (ctx 1)
    (zmq:with-socket (socket ctx zmq:req)
      (zmq:connect socket "tcp://127.0.0.1:5555")
      (loop
      (zmq:send socket (make-instance 'zmq:msg
                                      :data (read-line)))
      (let ((result (make-instance 'zmq:msg)))
        (zmq:recv socket result)
        (format t "Recieved message: '~A'~%"
                (zmq:msg-data-as-string result) ))))))

(client)

まとめ

Common Lisp(sbcl)でZeroMQを利用して、簡単なエコーサーバ/クライアントを実装した。

参考



sbclでクラスのスロット一覧を取得する方法

July 06, 2012 at 06:30 PM | categories: memo, sbcl, common lisp |

lisp

メモメモ

CL-USER> (sb-mop:class-slots (find-class 'sb-posix:stat))
(#<SB-MOP:STANDARD-EFFECTIVE-SLOT-DEFINITION SB-POSIX::MODE>
 #<SB-MOP:STANDARD-EFFECTIVE-SLOT-DEFINITION SB-POSIX::INO>
 #<SB-MOP:STANDARD-EFFECTIVE-SLOT-DEFINITION SB-POSIX::DEV>
 #<SB-MOP:STANDARD-EFFECTIVE-SLOT-DEFINITION SB-POSIX::NLINK>
 #<SB-MOP:STANDARD-EFFECTIVE-SLOT-DEFINITION SB-POSIX::UID>
 #<SB-MOP:STANDARD-EFFECTIVE-SLOT-DEFINITION SB-POSIX::GID>
 #<SB-MOP:STANDARD-EFFECTIVE-SLOT-DEFINITION SB-POSIX::SIZE>
 #<SB-MOP:STANDARD-EFFECTIVE-SLOT-DEFINITION SB-POSIX::ATIME>
 #<SB-MOP:STANDARD-EFFECTIVE-SLOT-DEFINITION SB-POSIX::MTIME>
 #<SB-MOP:STANDARD-EFFECTIVE-SLOT-DEFINITION SB-POSIX::CTIME>)


About Me

pic
mojavy

Recent posts






Categories



Badges