ヤーン

1月6日、家族みんなでヤーンの最後を看取った。仕事から帰ると迎えに出て来てくれるのはヤーンだった。

咬むの好きというより、むしろ咬まずにはいられないらしく、油断してると目をまん丸にして一番やわらかい二の腕の裏を狙って噛みついてくる。噛みついたうえに捻るものだからかなり痛かったよ。

遊んで欲しいときは猫じゃらしをくわえてやってきて、ちょとそこじゃ届かないよという場所に猫じゃらしを置く。うまく猫じゃらしを動かしてやるとぐるぐる走り回る。おいかけっこと待ち伏せも大好き。

ブルーポイントのシャム。

10年ほど前に横浜から埼玉まで車を走らせて迎えに行った。

ヤーンポッチナズムナイルピネロピルニャール卿バッハナスカレシン。

綺麗な猫。綺麗な青い目。

ニクキュウは小豆色で太陽の匂いじゃなくて苦い匂いがする。お耳はベルベットの様な毛並み。耳の後ろの毛はとてもやわらか。ふわふわ。

お風呂からあがるのを洗濯機の上で待っていて、背中をペンペン叩いてもらう。

寂しがりやで、人恋しいたちで、一人家に置いていかれた日にはいつもすごく文句を言っていた。

よくひざにのってた。ひざに Kinesis をのっけてても無理やりのってきてキーボードを打つ手首の上にあごをのせる。

1月9日、ヤーンのお葬式。

とてもいい天気。綺麗な青い空。綺麗な白い骨。

いいこのヤーンポチナ。

ぽちぽち、やんぽち。

ぽちぽち、やんぽち

昨日の続き (Common Lisp の IOLib でとても簡単な Web サーバを書く)

一年の最後に書くのも最初に書くのも Common Lisp でありたい。

Common Lisp の IOLib でとても簡単な Web サーバを書く。昨日との違いはコンパイラマクロを入れ、コンパイラが note をはからないように適当に最適化したたくらい。

ab してみる。マシンは Intel(R) Core(TM)2 Duo CPU T7100 @ 1.80GHz で。何もしないと秒間 4,000 リクエスト以上さばけるんだ。なんとなく Rails の遅さと nginx の速さに納得した。

ところで、受信イベントが2回発生し、2回目の receive-from は 0 バイトになる。そういうものなんだろうか?

outis:~% /usr/bin/ab -n 10000 -c 10 'http://localhost:8888/hello'
This is ApacheBench, Version 2.3 <$Revision: 655654 $>
Copyright 1996 Adam Twiss, Zeus Technology Ltd, http://www.zeustech.net/
Licensed to The Apache Software Foundation, http://www.apache.org/

Benchmarking localhost (be patient)
Completed 1000 requests
Completed 2000 requests
Completed 3000 requests
Completed 4000 requests
Completed 5000 requests
Completed 6000 requests
Completed 7000 requests
Completed 8000 requests
Completed 9000 requests
Completed 10000 requests
Finished 10000 requests


Server Software:
Server Hostname:        localhost
Server Port:            8888

Document Path:          /hello
Document Length:        40 bytes

Concurrency Level:      10
Time taken for tests:   2.282 seconds
Complete requests:      10000
Failed requests:        0
Write errors:           0
Total transferred:      970000 bytes
HTML transferred:       400000 bytes
Requests per second:    4382.89 [#/sec] (mean)
Time per request:       2.282 [ms] (mean)
Time per request:       0.228 [ms] (mean, across all concurrent requests)
Transfer rate:          415.18 [Kbytes/sec] received

Connection Times (ms)
              min  mean[+/-sd] median   max
Connect:        0    0  17.3      0    1002
Processing:     0    1  21.4      1    1380
Waiting:        0    1  21.4      1    1380
Total:          0    2  27.5      1    1380

Percentage of the requests served within a certain time (ms)
  50%      1
  66%      1
  75%      1
  80%      1
  90%      2
  95%      3
  98%      4
  99%      5
 100%   1380 (longest request)

#+nil
(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload :iolib)
  (ql:quickload :quek))

(quek:sdefpackage :httpd
                  (:use :cl))

(in-package :httpd)

(named-readtables:in-readtable quek:|#"|)

(defvar *httpd*)

(alexandria:define-constant +crlf+ (format nil "~c~c" #\cr #\lf) :test #'equalp)

(defun start (&key (port 8888))
  (declare (optimize (speed 3) (safety 0) (debug 0)))
  (setf *httpd* (make-instance 'iolib.multiplex:event-base))
  (let ((socket (iolib.sockets:make-socket :address-family :ipv4
                                           :type :stream
                                           :connect :passive
                                           :local-host "0.0.0.0"
                                           :local-port port
                                           :reuse-address t)))
    (iolib.sockets::listen-on socket)
    (describe socket)
    (iolib.multiplex::set-io-handler
     *httpd*
     (iolib.streams::fd-of socket)
     :read (lambda (fd event exception)
             (declare (ignore fd event exception))
             (let* ((client-socket (iolib.sockets:accept-connection socket))
                    (fd (iolib.streams:fd-of client-socket)))
               (iolib.multiplex:set-io-handler
                *httpd* fd
                :read (lambda (_fd event exception)
                        (declare (ignore _fd event exception))
                        (unwind-protect
                             (handler client-socket)
                          (iomux:remove-fd-handlers *httpd* fd)
                          (close client-socket)))))))
    (unwind-protect
         (iolib.multiplex:event-dispatch *httpd*)
      (close socket))))

(defun handler (client-socket)
  (declare (optimize (speed 3) (safety 0) (debug 0)))
  (let ((buffer (make-array 4096 :element-type '(unsigned-byte 8))))
    (declare (dynamic-extent buffer))
    (multiple-value-bind (buffer nbytes) (iolib.sockets:receive-from client-socket :buffer buffer)
      (declare (type fixnum nbytes))
      ;; イベントが2回発生し、2回目の receive-from は 0 バイトになる。そういうもの?
      (when (plusp nbytes)
          (multiple-value-bind (buffer nbytes) (request buffer nbytes)
            (iolib.sockets:send-to client-socket buffer :end nbytes))))))

(defun request (buffer nbytes)
  (declare (optimize (speed 3) (safety 0) (debug 0)))
  (declare (type (simple-array (unsigned-byte 8)) buffer))
  (let* ((start (position #x20 buffer :end nbytes))
         (end (position #x20 buffer :start (+ start 2) :end nbytes))
         (path (sb-ext:octets-to-string buffer
                                        :external-format :utf-8
                                        :start (1+ start)
                                        :end end))
         (symbol-name (prog1 (string-upcase path)
                        #|(format t "~&~a" path)|#))
         (symbol (or (find-symbol symbol-name :httpd) '/404)))
    (funcall (symbol-function symbol))))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun make-response (content)
    (declare (optimize (speed 3) (safety 0) (debug 0)))
    (let* ((response #"""HTTP/1.0 200#,+crlf+,Content-Type: text/html; charset=utf-8;#,+crlf+,#,+crlf+,#,content""")
           (buffer (sb-ext:string-to-octets response :external-format :utf-8)))
      (declare (type (simple-array (unsigned-byte 8)) buffer))
      (values buffer (length buffer)))))

(define-compiler-macro make-response (&whole form content &environment env)
  (if (constantp content env)
      (multiple-value-bind (buffer nbytes) (make-response content)
        `(values ,buffer ,nbytes))
      form))

(defun /hello ()
  (declare (optimize (speed 3) (safety 0) (debug 0)))
  (make-response "<html><body><h1>hello</h1></body></html>"))

(defun /404 ()
  (declare (optimize (speed 3) (safety 0) (debug 0)))
  (make-response "<html><body><h1>404</h1></body></html>"))