takagi/tsuru.lisp

## tsuru.lisp
;;;
;;; Fundamental WORD/INT types and readers
;;;

(deftype word8 ()
  `(unsigned-byte 8))

(deftype word16 ()
  `(unsigned-byte 16))

(deftype word32 ()
  `(unsigned-byte 32))

(deftype int8 ()
  `(signed-byte 8))

(deftype int16 ()
  `(signed-byte 16))

(deftype int32 ()
  `(signed-byte 32))

(defun read-word8 (stream)
  (read-byte stream))

(defun read-word16-le (stream)
  (+ (read-byte stream)
     (ash (read-byte stream) 8)))

(defun read-word32-le (stream)
  (+ (read-byte stream)
     (ash (read-byte stream) 8)
     (ash (read-byte stream) 16)
     (ash (read-byte stream) 24)))

(defun read-int8 (stream)
  (declare (ignore stream))
  (error "undefined"))

(defun read-int16-le (stream)
  (declare (ignore stream))
  (error "undefined"))

(defun word32->int32 (x)
  (declare (type (unsigned-byte 32) x))
  (if (< x #x80000000)
      x
      (- x (ash 2 31))))

(defun read-int32-le (stream)
  (word32->int32 (read-word32-le stream)))


;;;
;;; Pcap Global Header
;;;

(defstruct (pcap-hdr (:constructor %make-pcap-hdr))
  (magic-number 0 :type (unsigned-byte 32) :read-only t)
  (version-major :version-major :read-only t)
  (version-minor :version-minor :read-only t)
  (thiszone 0 :type (signed-byte 32) :read-only t)
  (sigfigs :sigfigs :read-only t)
  (snaplen :snaplen :read-only t)
  (network :network :read-only t))

(defun make-pcap-hdr (magic-number version-major version-minor thiszone sigfigs snaplen network)
  (%make-pcap-hdr :magic-number magic-number
                  :version-major version-major
                  :version-minor version-minor
                  :thiszone thiszone
                  :sigfigs sigfigs
                  :snaplen snaplen
                  :network network))

(defun read-pcap-hdr (stream)
  (make-pcap-hdr (read-word32-le stream)
                 (read-word16-le stream)
                 (read-word16-le stream)
                 (read-int32-le stream)
                 (read-word32-le stream)
                 (read-word32-le stream)
                 (read-word32-le stream)))


;;;
;;; Pcap Packet Header
;;;

(defstruct (pcap-rec-hdr (:constructor make-pcap-rec-hdr (ts-sec ts-usec incl-len orig-len)))
  (ts-sec 0 :type word32 :read-only t)
  (ts-usec 0 :type word32 :read-only t)
  (incl-len 0 :type word32 :read-only t)
  (orig-len 0 :type word32 :read-only t))

(defun read-pcap-rec-hdr (stream)
  (make-pcap-rec-hdr (read-word32-le stream)
                     (read-word32-le stream)
                     (read-word32-le stream)
                     (read-word32-le stream)))

(defun pcap-rec-hdr-timestamp (hdr)
  (local-time:unix-to-timestamp (pcap-rec-hdr-ts-sec hdr)
                                :nsec (* (pcap-rec-hdr-ts-usec hdr) 1000)))


;;;
;;; Pcap Packet Data
;;;

(defun read-pcap-rec-data (hdr stream)
  (let ((incl-len (pcap-rec-hdr-incl-len hdr)))
    (loop for i from 0 below incl-len
       collect (read-byte stream))))


;;;
;;; Quote Packet
;;;

(defstruct (quote-packet (:constructor %make-quote-packet))
  (packet-timestamp nil :read-only t)
  (quote-accept-timestamp nil :read-only t)
  (data-type nil :read-only t)
  (information-type nil :read-only t)
  (market-type nil :read-only t)
  (issue-code nil :read-only t)
  (issue-seq-no nil :read-only t)
  (market-status-type nil :read-only t)
  (total-bid-quote-volume nil :read-only t)
  (best-bid-price-1st nil :read-only t)
  (best-bid-quantity-1st nil :read-only t)
  (best-bid-price-2nd nil :read-only t)
  (best-bid-quantity-2nd nil :read-only t)
  (best-bid-price-3rd nil :read-only t)
  (best-bid-quantity-3rd nil :read-only t)
  (best-bid-price-4th nil :read-only t)
  (best-bid-quantity-4th nil :read-only t)
  (best-bid-price-5th nil :read-only t)
  (best-bid-quantity-5th nil :read-only t)
  (total-ask-quote-volume nil :read-only t)
  (best-ask-price-1st nil :read-only t)
  (best-ask-quantity-1st nil :read-only t)
  (best-ask-price-2nd nil :read-only t)
  (best-ask-quantity-2nd nil :read-only t)
  (best-ask-price-3rd nil :read-only t)
  (best-ask-quantity-3rd nil :read-only t)
  (best-ask-price-4th nil :read-only t)
  (best-ask-quantity-4th nil :read-only t)
  (best-ask-price-5th nil :read-only t)
  (best-ask-quantity-5th nil :read-only t)
  (no-of-best-bid-valid-quote nil :read-only t)
  (no-of-best-bid-quote-1st nil :read-only t)
  (no-of-best-bid-quote-2nd nil :read-only t)
  (no-of-best-bid-quote-3rd nil :read-only t)
  (no-of-best-bid-quote-4th nil :read-only t)
  (no-of-best-bid-quote-5th nil :read-only t)
  (no-of-best-ask-valid-quote nil :read-only t)
  (no-of-best-ask-quote-1st nil :read-only t)
  (no-of-best-ask-quote-2nd nil :read-only t)
  (no-of-best-ask-quote-3rd nil :read-only t)
  (no-of-best-ask-quote-4th nil :read-only t)
  (no-of-best-ask-quote-5th nil :read-only t)
  (quote-accept-time nil :read-only t)
  (end-of-message nil :read-only t))

(defun make-quote-packet (hdr data)
  (let ((quote-packet-data (quote-packet-data data)))
    (if quote-packet-data
        (let ((data1 (mapcar #'code-char quote-packet-data)))
          (let ((accept-timestamp (foo (pcap-rec-hdr-timestamp hdr)
                                       (coerce (subseq data1 206 214) 'string))))
            (%make-quote-packet :packet-timestamp (pcap-rec-hdr-timestamp hdr)
                                :quote-accept-timestamp accept-timestamp
                                :data-type (coerce (subseq data1 0 2) 'string)
                                :information-type (coerce (subseq data1 2 4) 'string)
                                :market-type (coerce (subseq data1 4 5) 'string)
                                :issue-code (coerce (subseq data1 5 17) 'string)
                                :issue-seq-no (coerce (subseq data1 17 20) 'string)
                                :market-status-type (coerce (subseq data1 20 22) 'string)
                                :total-bid-quote-volume (coerce (subseq data1 22 29) 'string)
                                :best-bid-price-1st (coerce (subseq data1 29 34) 'string)
                                :best-bid-quantity-1st (coerce (subseq data1 34 41) 'string)
                                :best-bid-price-2nd (coerce (subseq data1 41 46) 'string)
                                :best-bid-quantity-2nd (coerce (subseq data1 46 53) 'string)
                                :best-bid-price-3rd (coerce (subseq data1 53 58) 'string)
                                :best-bid-quantity-3rd (coerce (subseq data1 58 65) 'string)
                                :best-bid-price-4th (coerce (subseq data1 65 70) 'string)
                                :best-bid-quantity-4th (coerce (subseq data1 70 77) 'string)
                                :best-bid-price-5th (coerce (subseq data1 77 82) 'string)
                                :best-bid-quantity-5th (coerce (subseq data1 82 89) 'string)
                                :total-ask-quote-volume (coerce (subseq data1 89 96) 'string)
                                :best-ask-price-1st (coerce (subseq data1 96 101) 'string)
                                :best-ask-quantity-1st (coerce (subseq data1 101 108) 'string)
                                :best-ask-price-2nd (coerce (subseq data1 108 113) 'string)
                                :best-ask-quantity-2nd (coerce (subseq data1 113 120) 'string)
                                :best-ask-price-3rd (coerce (subseq data1 120 125) 'string)
                                :best-ask-quantity-3rd (coerce (subseq data1 125 132) 'string)
                                :best-ask-price-4th (coerce (subseq data1 132 137) 'string)
                                :best-ask-quantity-4th (coerce (subseq data1 137 144) 'string)
                                :best-ask-price-5th (coerce (subseq data1 144 149) 'string)
                                :best-ask-quantity-5th (coerce (subseq data1 149 156) 'string)
                                :no-of-best-bid-valid-quote (coerce (subseq data1 156 161) 'string)
                                :no-of-best-bid-quote-1st (coerce (subseq data1 161 165) 'string)
                                :no-of-best-bid-quote-2nd (coerce (subseq data1 165 169) 'string)
                                :no-of-best-bid-quote-3rd (coerce (subseq data1 169 173) 'string)
                                :no-of-best-bid-quote-4th (coerce (subseq data1 173 177) 'string)
                                :no-of-best-bid-quote-5th (coerce (subseq data1 177 181) 'string)
                                :no-of-best-ask-valid-quote (coerce (subseq data1 181 186) 'string)
                                :no-of-best-ask-quote-1st (coerce (subseq data1 186 190) 'string)
                                :no-of-best-ask-quote-2nd (coerce (subseq data1 190 194) 'string)
                                :no-of-best-ask-quote-3rd (coerce (subseq data1 194 198) 'string)
                                :no-of-best-ask-quote-4th (coerce (subseq data1 198 202) 'string)
                                :no-of-best-ask-quote-5th (coerce (subseq data1 202 206) 'string)
                                :quote-accept-time (coerce (subseq data1 206 214) 'string)
                                :end-of-message (char-code (nth 214 data1)))))
        nil)))

(defun foo (bar baz)
  (let* ((accept-time baz)
         (hour (read-from-string (subseq accept-time 0 2)))
         (minute (read-from-string (subseq accept-time 2 4)))
         (second (read-from-string (subseq accept-time 4 6)))
         (msecond (* (read-from-string (subseq accept-time 6 8)) 10)))
    (let ((packet-timestamp bar))
      (local-time:encode-timestamp (* msecond 1000000)
                                   second
                                   minute
                                   hour
                                   (local-time:timestamp-day packet-timestamp)
                                   (local-time:timestamp-month packet-timestamp)
                                   (local-time:timestamp-year packet-timestamp)))))

;; (defun quote-packet-quote-accept-timestamp (quote-packet)
;;   (let* ((accept-time (quote-packet-quote-accept-time quote-packet))
;;          (hour (read-from-string (subseq accept-time 0 2)))
;;          (minute (read-from-string (subseq accept-time 2 4)))
;;          (second (read-from-string (subseq accept-time 4 6)))
;;          (msecond (* (read-from-string (subseq accept-time 6 8)) 10)))
;;     (let ((packet-timestamp (quote-packet-packet-timestamp quote-packet)))
;;       (local-time:encode-timestamp (* msecond 1000000)
;;                                    second
;;                                    minute
;;                                    hour
;;                                    (local-time:timestamp-day packet-timestamp)
;;                                    (local-time:timestamp-month packet-timestamp)
;;                                    (local-time:timestamp-year packet-timestamp)))))

(defun quote-packet-data (data)
  (labels ((aux (data)
             (if (< (length data) 5)
                 nil
                 (destructuring-bind (x0 x1 x2 x3 x4 . _) data
                   (declare (ignore _))
                   (if (and (= x0 66) (= x1 54) (= x2 48) (= x3 51) (= x4 52))
                       data
                       (aux (cdr data)))))))
    (aux data)))


;;;
;;; Ordering Buffer
;;;

(defstruct (ordering-buffer (:constructor %make-ordering-buffer))
  packets
  current-packet-timestamp)

(defun make-ordering-buffer ()
  (%make-ordering-buffer))

(defun ordering-buffer-count (buffer)
  (length (ordering-buffer-packets buffer)))

(defun timestamp-difference (time-a time-b)
  (let ((nsec (- (local-time:nsec-of time-a) (local-time:nsec-of time-b)))
        (second (- (local-time:sec-of time-a) (local-time:sec-of time-b)))
        (day (- (local-time:day-of time-a) (local-time:day-of time-b))))
    (declare (type (signed-byte 32) second nsec)
             (type (unsigned-byte 32) day))
    (when (minusp nsec)
      (decf second)
      (incf nsec 1000000000))
    (when (minusp second)
      (decf day)
      (incf second local-time:+seconds-per-day+))
    (+ (* day local-time:+seconds-per-day+)
       second)))

(defun passed-three-seconds-p (buffer quote-packet)
  (let ((packet-timestamp (ordering-buffer-current-packet-timestamp buffer))
        (accept-timestamp (quote-packet-quote-accept-timestamp quote-packet)))
    (> (timestamp-difference packet-timestamp accept-timestamp)
       3)))

(defun insert-quote-packet (packets packet)
  (labels ((aux (packets packet)
             (if (null packets)
                 (cons packet nil)
                 (destructuring-bind (packet0 . rest) packets
                   (if (or (string> (quote-packet-quote-accept-time packet)
                                    (quote-packet-quote-accept-time packet0))
                           (and (string= (quote-packet-quote-accept-time packet)
                                         (quote-packet-quote-accept-time packet0))
                                (local-time:timestamp>
                                 (quote-packet-packet-timestamp packet)
                                 (quote-packet-packet-timestamp packet0))))
                       (cons packet packets)
                       (cons packet0 (aux rest packet)))))))
    (aux packets packet)))

(defun ordering-buffer-insert (buffer hdr quote-packet)
  ;; Insert the quote packet to the ordering buffer, sorting by the quote
  ;; accept time order.
  (setf (ordering-buffer-packets buffer)
        (insert-quote-packet (ordering-buffer-packets buffer) quote-packet))
  ;; Keep the packet timestamp.
  (setf (ordering-buffer-current-packet-timestamp buffer)
        (pcap-rec-hdr-timestamp hdr))
  buffer)

(defun ordering-buffer-pop (buffer)
  ;; Return quote packets whose quote accept times exceed more than three
  ;; seconds after the packet time in the quote accept time order.
  (labels ((aux (packets in-packets)
             (if (null packets)
                 (values in-packets nil)
                 (destructuring-bind (packet . rest) packets
                   (if (passed-three-seconds-p buffer packet)
                       (values in-packets packets)
                       (aux rest (cons packet in-packets)))))))
    (multiple-value-bind (in-packets out-packets)
        (aux (ordering-buffer-packets buffer) nil)
      (setf (ordering-buffer-packets buffer) (nreverse in-packets))
      (nreverse out-packets))))

(defun ordering-buffer-pop-all (buffer)
  ;; Return all quote packets left in the ordering buffer.
  (prog1 (nreverse (ordering-buffer-packets buffer))
    (setf (ordering-buffer-packets buffer) nil
          (ordering-buffer-current-packet-timestamp buffer) nil)))


;;;
;;; Main
;;;

(defun print-feed (quote-packet)
  (local-time:format-timestring t (quote-packet-packet-timestamp quote-packet))
  (format t " ")
  (format t "~A " (quote-packet-quote-accept-timestamp quote-packet))
  (format t "~A " (quote-packet-issue-code quote-packet))
  (format t "~A@~A " (quote-packet-best-bid-quantity-5th quote-packet)
                     (quote-packet-best-bid-price-5th quote-packet))
  (format t "~A@~A " (quote-packet-best-bid-quantity-4th quote-packet)
                     (quote-packet-best-bid-price-4th quote-packet))
  (format t "~A@~A " (quote-packet-best-bid-quantity-3rd quote-packet)
                     (quote-packet-best-bid-price-3rd quote-packet))
  (format t "~A@~A " (quote-packet-best-bid-quantity-2nd quote-packet)
                     (quote-packet-best-bid-price-2nd quote-packet))
  (format t "~A@~A " (quote-packet-best-bid-quantity-1st quote-packet)
                     (quote-packet-best-bid-price-1st quote-packet))
  (format t "~A@~A " (quote-packet-best-ask-quantity-1st quote-packet)
                     (quote-packet-best-ask-price-1st quote-packet))
  (format t "~A@~A " (quote-packet-best-ask-quantity-2nd quote-packet)
                     (quote-packet-best-ask-price-2nd quote-packet))
  (format t "~A@~A " (quote-packet-best-ask-quantity-3rd quote-packet)
                     (quote-packet-best-ask-price-3rd quote-packet))
  (format t "~A@~A " (quote-packet-best-ask-quantity-4th quote-packet)
                     (quote-packet-best-ask-price-4th quote-packet))
  (format t "~A@~A~%" (quote-packet-best-ask-quantity-5th quote-packet)
                      (quote-packet-best-ask-price-5th quote-packet))
  (fresh-line))

(defun main ()
  (with-open-file (out "out" :direction :output :if-exists :supersede)
    (let ((buffer (make-ordering-buffer)))
      (let ((*standard-output* out))
        (with-open-file (in "data" :direction :input
                            :element-type '(unsigned-byte 8))
          (read-pcap-hdr in)
          (handler-case
              (loop
                 (let* ((hdr (read-pcap-rec-hdr in))
                        (data (read-pcap-rec-data hdr in)))
                   (let ((quote-packet (make-quote-packet hdr data)))
                     (when quote-packet
                       (ordering-buffer-insert buffer hdr quote-packet)
                       (loop for packet in (ordering-buffer-pop buffer)
                          do (print-feed packet))))))
            (end-of-file ()))
          (loop for packet in (ordering-buffer-pop-all buffer)
             do (print-feed packet)))))))


;;;
;;; Profile
;;;

(require :sb-sprof)

(defun do-profile ()
  (sb-sprof:with-profiling (:max-samples 100
                            :report :graph
                            :loop nil)
    (main)))

## tsuru2.lisp
;;;
;;; INCOMPLETE
;;;

;;;
;;; Fundamental WORD/INT types and readers
;;;

(deftype word8 ()
  `(unsigned-byte 8))

(deftype word16 ()
  `(unsigned-byte 16))

(deftype word32 ()
  `(unsigned-byte 32))

(deftype int8 ()
  `(signed-byte 8))

(deftype int16 ()
  `(signed-byte 16))

(deftype int32 ()
  `(signed-byte 32))

(defun read-word8 (stream)
  (read-byte stream))

(defun read-word16-le (stream)
  (+ (read-byte stream)
     (ash (read-byte stream) 8)))

(defun read-word32-le (stream)
  (+ (read-byte stream)
     (ash (read-byte stream) 8)
     (ash (read-byte stream) 16)
     (ash (read-byte stream) 24)))

(defun read-int8 (stream)
  (declare (ignore stream))
  (error "undefined"))

(defun read-int16-le (stream)
  (declare (ignore stream))
  (error "undefined"))

(defun word32->int32 (x)
  (declare (type (unsigned-byte 32) x))
  (if (< x #x80000000)
      x
      (- x (ash 2 31))))

(defun read-int32-le (stream)
  (word32->int32 (read-word32-le stream)))


;;;
;;; Ordering Buffer
;;;

(defparameter +quote-packet-data-size+ 214)

(defparameter +quote-packet-size+ (+ +quote-packet-size+ 4))

(defparameter +max-quote-packets+ 1024)

(defstruct (ordering-buffer (:constructor %make-ordering-buffer))
  buffer
  newest
  oldest)

(defun make-ordering-buffer ()
  (let ((buffer (make-array (* +max-quote-packets+ +quote-packet-size+)
                            :element-type '(unsigned-byte 8)
                            :initial-element #x00)))
    (%make-ordering-buffer :buffer buffer :newest 0 :oldest 0)))

(defun ordering-buffer-index (i)
  (unless (and (<= 0 i)
               (< i +max-quote-packets+))
    (error "The value ~S is out of boundary of the ordering buffer." i))
  (* i +quote-packet-size+))

(defun ordering-buffer-newest-index (buffer)
  (ordering-buffer-index (ordering-buffer-newest buffer)))

(defun ordering-buffer-oldest-index (buffer)
  (ordering-buffer-index (ordering-buffer-oldest buffer)))

(defun ordering-buffer-empty-p (buffer)
  (= (ordering-buffer-newest buffer)
     (ordering-buffer-oldest buffer)))

(defun ordering-buffer-full-p (buffer)
  (let ((newest (ordering-buffer-newest buffer))
        (oldest (ordering-buffer-oldest buffer)))
    (when (< newest oldest)
      (incf newest +max-quote-packets+))
    (= (- newest oldest) (- +max-quote-packets+ 1))))

(defun ordering-buffer-increment-newest (buffer)
  (unless (not (ordering-buffer-full-p buffer))
    (error "The ordering buffer is full."))
  (incf (ordering-buffer-newest buffer))
  (if (= +max-quote-packets+ (ordering-buffer-newest buffer))
      (setf (ordering-buffer-newest buffer) 0))
  buffer)

(defun ordering-buffer-increment-oldest (buffer)
  (unless (not (ordering-buffer-empty-p buffer))
    (error "The ordering buffer is empty."))
  (incf (ordering-buffer-oldest buffer))
  (if (= +max-quote-packets+ (ordering-buffer-oldest buffer))
      (setf (ordering-buffer-oldest buffer) 0))
  buffer)

(defun ordering-buffer-oldest-passed-four-seconds-p (buffer)
  (unless (not (ordering-buffer-empty-p buffer))
    (error "The ordering buffer is empty."))
  nil)

(defun ordering-buffer-get-string (buffer i length)
  (coerce
   (loop repeat length
         for i0 from (ordering-buffer-index i)
      collect (code-char (aref (ordering-buffer-buffer buffer) i0)))
   'string))

(defun ordering-buffer-get-int8 (buffer i)
  nil)

(defun ordering-buffer-get-int16-le (buffer i)
  nil)

(defun ordering-buffer-get-int32-le (buffer i)
  nil)

(defun ordering-buffer-get-word8 (buffer i)
  nil)

(defun ordering-buffer-get-word16-le (buffer i)
  nil)

(defun ordering-buffer-get-word32-le (buffer i)
  (let ((buffer% (ordering-buffer-buffer buffer))
        (i0 (ordering-buffer-index i)))
    (+ (ash (aref buffer% (+ i0 3)) 24)
       (ash (aref buffer% (+ i0 2)) 16)
       (ash (aref buffer% (+ i0 1)) 8)
       (aref buffer% i0))))

(defun ordering-buffer-data-type (buffer i)
  (ordering-buffer-get-string buffer i 2))

(defun ordering-buffer-read-quote-packet (buffer stream)
  (unless (not (ordering-buffer-full-p buffer))
    (error "The ordering buffer is full."))
  ;; read packet header

  ;; read packet data with searching quote packet from stream
  (read-sequence (ordering-buffer-buffer buffer) stream
                 :start (ordering-buffer-newest-index buffer)
                 :end (+ (ordering-buffer-newest-index buffer)
                         +quote-packet-data-size+))
  ;; order by quote accept time

  ;; update the newest pointer
  (ordering-buffer-increment-newest buffer))

(defmacro ordering-buffer-do-quote-packet ((var buffer) &body body)
  ;; TODO: once only buffer
  `(loop
      while (and (not (ordering-buffer-empty-p ,buffer))
                 (ordering-buffer-oldest-passed-four-seconds-p ,buffer))
      do (let ((,var (ordering-buffer-oldest ,buffer)))
           ,@body)
         (ordering-buffer-increment-oldest ,buffer)))

(defun read-pcap-hdr (stream)
  (read-word32-le stream)
  (read-word16-le stream)
  (read-word16-le stream)
  (read-int32-le stream)
  (read-word32-le stream)
  (read-word32-le stream)
  (read-word32-le stream))

(defun main ()
  (let ((buffer (make-ordering-buffer)))
    (with-open-file (in "data" :direction :input
                               :element-type '(unsigned-byte 8))
      (read-pcap-hdr in)
      ;; TODO: handling EOF?
      (handler-case
          (loop
             (ordering-buffer-read-quote-packet buffer in)
             (do-ordering-buffer-quote-packet (i buffer)
               (print-feed buffer i)))
        (end-of-file ()))
      (do-ordering-buffer-quote-packet-all (i buffer)
        (print-feed buffer i)))))
	;;;
	;;; Fundamental WORD/INT types and readers
	;;;

	(deftype word8 ()
	`(unsigned-byte 8))

	(deftype word16 ()
	`(unsigned-byte 16))

	(deftype word32 ()
	`(unsigned-byte 32))

	(deftype int8 ()
	`(signed-byte 8))

	(deftype int16 ()
	`(signed-byte 16))

	(deftype int32 ()
	`(signed-byte 32))

	(defun read-word8 (stream)
	(read-byte stream))

	(defun read-word16-le (stream)
	(+ (read-byte stream)
	(ash (read-byte stream) 8)))

	(defun read-word32-le (stream)
	(+ (read-byte stream)
	(ash (read-byte stream) 8)
	(ash (read-byte stream) 16)
	(ash (read-byte stream) 24)))

	(defun read-int8 (stream)
	(declare (ignore stream))
	(error "undefined"))

	(defun read-int16-le (stream)
	(declare (ignore stream))
	(error "undefined"))

	(defun word32->int32 (x)
	(declare (type (unsigned-byte 32) x))
	(if (< x #x80000000)
	x
	(- x (ash 2 31))))

	(defun read-int32-le (stream)
	(word32->int32 (read-word32-le stream)))


	;;;
	;;; Pcap Global Header
	;;;

	(defstruct (pcap-hdr (:constructor %make-pcap-hdr))
	(magic-number 0 :type (unsigned-byte 32) :read-only t)
	(version-major :version-major :read-only t)
	(version-minor :version-minor :read-only t)
	(thiszone 0 :type (signed-byte 32) :read-only t)
	(sigfigs :sigfigs :read-only t)
	(snaplen :snaplen :read-only t)
	(network :network :read-only t))

	(defun make-pcap-hdr (magic-number version-major version-minor thiszone sigfigs snaplen network)
	(%make-pcap-hdr :magic-number magic-number
	:version-major version-major
	:version-minor version-minor
	:thiszone thiszone
	:sigfigs sigfigs
	:snaplen snaplen
	:network network))

	(defun read-pcap-hdr (stream)
	(make-pcap-hdr (read-word32-le stream)
	(read-word16-le stream)
	(read-word16-le stream)
	(read-int32-le stream)
	(read-word32-le stream)
	(read-word32-le stream)
	(read-word32-le stream)))


	;;;
	;;; Pcap Packet Header
	;;;

	(defstruct (pcap-rec-hdr (:constructor make-pcap-rec-hdr (ts-sec ts-usec incl-len orig-len)))
	(ts-sec 0 :type word32 :read-only t)
	(ts-usec 0 :type word32 :read-only t)
	(incl-len 0 :type word32 :read-only t)
	(orig-len 0 :type word32 :read-only t))

	(defun read-pcap-rec-hdr (stream)
	(make-pcap-rec-hdr (read-word32-le stream)
	(read-word32-le stream)
	(read-word32-le stream)
	(read-word32-le stream)))

	(defun pcap-rec-hdr-timestamp (hdr)
	(local-time:unix-to-timestamp (pcap-rec-hdr-ts-sec hdr)
	:nsec (* (pcap-rec-hdr-ts-usec hdr) 1000)))


	;;;
	;;; Pcap Packet Data
	;;;

	(defun read-pcap-rec-data (hdr stream)
	(let ((incl-len (pcap-rec-hdr-incl-len hdr)))
	(loop for i from 0 below incl-len
	collect (read-byte stream))))


	;;;
	;;; Quote Packet
	;;;

	(defstruct (quote-packet (:constructor %make-quote-packet))
	(packet-timestamp nil :read-only t)
	(quote-accept-timestamp nil :read-only t)
	(data-type nil :read-only t)
	(information-type nil :read-only t)
	(market-type nil :read-only t)
	(issue-code nil :read-only t)
	(issue-seq-no nil :read-only t)
	(market-status-type nil :read-only t)
	(total-bid-quote-volume nil :read-only t)
	(best-bid-price-1st nil :read-only t)
	(best-bid-quantity-1st nil :read-only t)
	(best-bid-price-2nd nil :read-only t)
	(best-bid-quantity-2nd nil :read-only t)
	(best-bid-price-3rd nil :read-only t)
	(best-bid-quantity-3rd nil :read-only t)
	(best-bid-price-4th nil :read-only t)
	(best-bid-quantity-4th nil :read-only t)
	(best-bid-price-5th nil :read-only t)
	(best-bid-quantity-5th nil :read-only t)
	(total-ask-quote-volume nil :read-only t)
	(best-ask-price-1st nil :read-only t)
	(best-ask-quantity-1st nil :read-only t)
	(best-ask-price-2nd nil :read-only t)
	(best-ask-quantity-2nd nil :read-only t)
	(best-ask-price-3rd nil :read-only t)
	(best-ask-quantity-3rd nil :read-only t)
	(best-ask-price-4th nil :read-only t)
	(best-ask-quantity-4th nil :read-only t)
	(best-ask-price-5th nil :read-only t)
	(best-ask-quantity-5th nil :read-only t)
	(no-of-best-bid-valid-quote nil :read-only t)
	(no-of-best-bid-quote-1st nil :read-only t)
	(no-of-best-bid-quote-2nd nil :read-only t)
	(no-of-best-bid-quote-3rd nil :read-only t)
	(no-of-best-bid-quote-4th nil :read-only t)
	(no-of-best-bid-quote-5th nil :read-only t)
	(no-of-best-ask-valid-quote nil :read-only t)
	(no-of-best-ask-quote-1st nil :read-only t)
	(no-of-best-ask-quote-2nd nil :read-only t)
	(no-of-best-ask-quote-3rd nil :read-only t)
	(no-of-best-ask-quote-4th nil :read-only t)
	(no-of-best-ask-quote-5th nil :read-only t)
	(quote-accept-time nil :read-only t)
	(end-of-message nil :read-only t))

	(defun make-quote-packet (hdr data)
	(let ((quote-packet-data (quote-packet-data data)))
	(if quote-packet-data
	(let ((data1 (mapcar #'code-char quote-packet-data)))
	(let ((accept-timestamp (foo (pcap-rec-hdr-timestamp hdr)
	(coerce (subseq data1 206 214) 'string))))
	(%make-quote-packet :packet-timestamp (pcap-rec-hdr-timestamp hdr)
	:quote-accept-timestamp accept-timestamp
	:data-type (coerce (subseq data1 0 2) 'string)
	:information-type (coerce (subseq data1 2 4) 'string)
	:market-type (coerce (subseq data1 4 5) 'string)
	:issue-code (coerce (subseq data1 5 17) 'string)
	:issue-seq-no (coerce (subseq data1 17 20) 'string)
	:market-status-type (coerce (subseq data1 20 22) 'string)
	:total-bid-quote-volume (coerce (subseq data1 22 29) 'string)
	:best-bid-price-1st (coerce (subseq data1 29 34) 'string)
	:best-bid-quantity-1st (coerce (subseq data1 34 41) 'string)
	:best-bid-price-2nd (coerce (subseq data1 41 46) 'string)
	:best-bid-quantity-2nd (coerce (subseq data1 46 53) 'string)
	:best-bid-price-3rd (coerce (subseq data1 53 58) 'string)
	:best-bid-quantity-3rd (coerce (subseq data1 58 65) 'string)
	:best-bid-price-4th (coerce (subseq data1 65 70) 'string)
	:best-bid-quantity-4th (coerce (subseq data1 70 77) 'string)
	:best-bid-price-5th (coerce (subseq data1 77 82) 'string)
	:best-bid-quantity-5th (coerce (subseq data1 82 89) 'string)
	:total-ask-quote-volume (coerce (subseq data1 89 96) 'string)
	:best-ask-price-1st (coerce (subseq data1 96 101) 'string)
	:best-ask-quantity-1st (coerce (subseq data1 101 108) 'string)
	:best-ask-price-2nd (coerce (subseq data1 108 113) 'string)
	:best-ask-quantity-2nd (coerce (subseq data1 113 120) 'string)
	:best-ask-price-3rd (coerce (subseq data1 120 125) 'string)
	:best-ask-quantity-3rd (coerce (subseq data1 125 132) 'string)
	:best-ask-price-4th (coerce (subseq data1 132 137) 'string)
	:best-ask-quantity-4th (coerce (subseq data1 137 144) 'string)
	:best-ask-price-5th (coerce (subseq data1 144 149) 'string)
	:best-ask-quantity-5th (coerce (subseq data1 149 156) 'string)
	:no-of-best-bid-valid-quote (coerce (subseq data1 156 161) 'string)
	:no-of-best-bid-quote-1st (coerce (subseq data1 161 165) 'string)
	:no-of-best-bid-quote-2nd (coerce (subseq data1 165 169) 'string)
	:no-of-best-bid-quote-3rd (coerce (subseq data1 169 173) 'string)
	:no-of-best-bid-quote-4th (coerce (subseq data1 173 177) 'string)
	:no-of-best-bid-quote-5th (coerce (subseq data1 177 181) 'string)
	:no-of-best-ask-valid-quote (coerce (subseq data1 181 186) 'string)
	:no-of-best-ask-quote-1st (coerce (subseq data1 186 190) 'string)
	:no-of-best-ask-quote-2nd (coerce (subseq data1 190 194) 'string)
	:no-of-best-ask-quote-3rd (coerce (subseq data1 194 198) 'string)
	:no-of-best-ask-quote-4th (coerce (subseq data1 198 202) 'string)
	:no-of-best-ask-quote-5th (coerce (subseq data1 202 206) 'string)
	:quote-accept-time (coerce (subseq data1 206 214) 'string)
	:end-of-message (char-code (nth 214 data1)))))
	nil)))

	(defun foo (bar baz)
	(let* ((accept-time baz)
	(hour (read-from-string (subseq accept-time 0 2)))
	(minute (read-from-string (subseq accept-time 2 4)))
	(second (read-from-string (subseq accept-time 4 6)))
	(msecond (* (read-from-string (subseq accept-time 6 8)) 10)))
	(let ((packet-timestamp bar))
	(local-time:encode-timestamp (* msecond 1000000)
	second
	minute
	hour
	(local-time:timestamp-day packet-timestamp)
	(local-time:timestamp-month packet-timestamp)
	(local-time:timestamp-year packet-timestamp)))))

	;; (defun quote-packet-quote-accept-timestamp (quote-packet)
	;; (let* ((accept-time (quote-packet-quote-accept-time quote-packet))
	;; (hour (read-from-string (subseq accept-time 0 2)))
	;; (minute (read-from-string (subseq accept-time 2 4)))
	;; (second (read-from-string (subseq accept-time 4 6)))
	;; (msecond (* (read-from-string (subseq accept-time 6 8)) 10)))
	;; (let ((packet-timestamp (quote-packet-packet-timestamp quote-packet)))
	;; (local-time:encode-timestamp (* msecond 1000000)
	;; second
	;; minute
	;; hour
	;; (local-time:timestamp-day packet-timestamp)
	;; (local-time:timestamp-month packet-timestamp)
	;; (local-time:timestamp-year packet-timestamp)))))

	(defun quote-packet-data (data)
	(labels ((aux (data)
	(if (< (length data) 5)
	nil
	(destructuring-bind (x0 x1 x2 x3 x4 . _) data
	(declare (ignore _))
	(if (and (= x0 66) (= x1 54) (= x2 48) (= x3 51) (= x4 52))
	data
	(aux (cdr data)))))))
	(aux data)))


	;;;
	;;; Ordering Buffer
	;;;

	(defstruct (ordering-buffer (:constructor %make-ordering-buffer))
	packets
	current-packet-timestamp)

	(defun make-ordering-buffer ()
	(%make-ordering-buffer))

	(defun ordering-buffer-count (buffer)
	(length (ordering-buffer-packets buffer)))

	(defun timestamp-difference (time-a time-b)
	(let ((nsec (- (local-time:nsec-of time-a) (local-time:nsec-of time-b)))
	(second (- (local-time:sec-of time-a) (local-time:sec-of time-b)))
	(day (- (local-time:day-of time-a) (local-time:day-of time-b))))
	(declare (type (signed-byte 32) second nsec)
	(type (unsigned-byte 32) day))
	(when (minusp nsec)
	(decf second)
	(incf nsec 1000000000))
	(when (minusp second)
	(decf day)
	(incf second local-time:+seconds-per-day+))
	(+ (* day local-time:+seconds-per-day+)
	second)))

	(defun passed-three-seconds-p (buffer quote-packet)
	(let ((packet-timestamp (ordering-buffer-current-packet-timestamp buffer))
	(accept-timestamp (quote-packet-quote-accept-timestamp quote-packet)))
	(> (timestamp-difference packet-timestamp accept-timestamp)
	3)))

	(defun insert-quote-packet (packets packet)
	(labels ((aux (packets packet)
	(if (null packets)
	(cons packet nil)
	(destructuring-bind (packet0 . rest) packets
	(if (or (string> (quote-packet-quote-accept-time packet)
	(quote-packet-quote-accept-time packet0))
	(and (string= (quote-packet-quote-accept-time packet)
	(quote-packet-quote-accept-time packet0))
	(local-time:timestamp>
	(quote-packet-packet-timestamp packet)
	(quote-packet-packet-timestamp packet0))))
	(cons packet packets)
	(cons packet0 (aux rest packet)))))))
	(aux packets packet)))

	(defun ordering-buffer-insert (buffer hdr quote-packet)
	;; Insert the quote packet to the ordering buffer, sorting by the quote
	;; accept time order.
	(setf (ordering-buffer-packets buffer)
	(insert-quote-packet (ordering-buffer-packets buffer) quote-packet))
	;; Keep the packet timestamp.
	(setf (ordering-buffer-current-packet-timestamp buffer)
	(pcap-rec-hdr-timestamp hdr))
	buffer)

	(defun ordering-buffer-pop (buffer)
	;; Return quote packets whose quote accept times exceed more than three
	;; seconds after the packet time in the quote accept time order.
	(labels ((aux (packets in-packets)
	(if (null packets)
	(values in-packets nil)
	(destructuring-bind (packet . rest) packets
	(if (passed-three-seconds-p buffer packet)
	(values in-packets packets)
	(aux rest (cons packet in-packets)))))))
	(multiple-value-bind (in-packets out-packets)
	(aux (ordering-buffer-packets buffer) nil)
	(setf (ordering-buffer-packets buffer) (nreverse in-packets))
	(nreverse out-packets))))

	(defun ordering-buffer-pop-all (buffer)
	;; Return all quote packets left in the ordering buffer.
	(prog1 (nreverse (ordering-buffer-packets buffer))
	(setf (ordering-buffer-packets buffer) nil
	(ordering-buffer-current-packet-timestamp buffer) nil)))


	;;;
	;;; Main
	;;;

	(defun print-feed (quote-packet)
	(local-time:format-timestring t (quote-packet-packet-timestamp quote-packet))
	(format t " ")
	(format t "~A " (quote-packet-quote-accept-timestamp quote-packet))
	(format t "~A " (quote-packet-issue-code quote-packet))
	(format t "~A@~A " (quote-packet-best-bid-quantity-5th quote-packet)
	(quote-packet-best-bid-price-5th quote-packet))
	(format t "~A@~A " (quote-packet-best-bid-quantity-4th quote-packet)
	(quote-packet-best-bid-price-4th quote-packet))
	(format t "~A@~A " (quote-packet-best-bid-quantity-3rd quote-packet)
	(quote-packet-best-bid-price-3rd quote-packet))
	(format t "~A@~A " (quote-packet-best-bid-quantity-2nd quote-packet)
	(quote-packet-best-bid-price-2nd quote-packet))
	(format t "~A@~A " (quote-packet-best-bid-quantity-1st quote-packet)
	(quote-packet-best-bid-price-1st quote-packet))
	(format t "~A@~A " (quote-packet-best-ask-quantity-1st quote-packet)
	(quote-packet-best-ask-price-1st quote-packet))
	(format t "~A@~A " (quote-packet-best-ask-quantity-2nd quote-packet)
	(quote-packet-best-ask-price-2nd quote-packet))
	(format t "~A@~A " (quote-packet-best-ask-quantity-3rd quote-packet)
	(quote-packet-best-ask-price-3rd quote-packet))
	(format t "~A@~A " (quote-packet-best-ask-quantity-4th quote-packet)
	(quote-packet-best-ask-price-4th quote-packet))
	(format t "~A@~A~%" (quote-packet-best-ask-quantity-5th quote-packet)
	(quote-packet-best-ask-price-5th quote-packet))
	(fresh-line))

	(defun main ()
	(with-open-file (out "out" :direction :output :if-exists :supersede)
	(let ((buffer (make-ordering-buffer)))
	(let ((standard-output out))
	(with-open-file (in "data" :direction :input
	:element-type '(unsigned-byte 8))
	(read-pcap-hdr in)
	(handler-case
	(loop
	(let* ((hdr (read-pcap-rec-hdr in))
	(data (read-pcap-rec-data hdr in)))
	(let ((quote-packet (make-quote-packet hdr data)))
	(when quote-packet
	(ordering-buffer-insert buffer hdr quote-packet)
	(loop for packet in (ordering-buffer-pop buffer)
	do (print-feed packet))))))
	(end-of-file ()))
	(loop for packet in (ordering-buffer-pop-all buffer)
	do (print-feed packet)))))))


	;;;
	;;; Profile
	;;;

	(require :sb-sprof)

	(defun do-profile ()
	(sb-sprof:with-profiling (:max-samples 100
	:report :graph
	:loop nil)
	(main)))
	;;;
	;;; INCOMPLETE
	;;;

	;;;
	;;; Fundamental WORD/INT types and readers
	;;;

	(deftype word8 ()
	`(unsigned-byte 8))

	(deftype word16 ()
	`(unsigned-byte 16))

	(deftype word32 ()
	`(unsigned-byte 32))

	(deftype int8 ()
	`(signed-byte 8))

	(deftype int16 ()
	`(signed-byte 16))

	(deftype int32 ()
	`(signed-byte 32))

	(defun read-word8 (stream)
	(read-byte stream))

	(defun read-word16-le (stream)
	(+ (read-byte stream)
	(ash (read-byte stream) 8)))

	(defun read-word32-le (stream)
	(+ (read-byte stream)
	(ash (read-byte stream) 8)
	(ash (read-byte stream) 16)
	(ash (read-byte stream) 24)))

	(defun read-int8 (stream)
	(declare (ignore stream))
	(error "undefined"))

	(defun read-int16-le (stream)
	(declare (ignore stream))
	(error "undefined"))

	(defun word32->int32 (x)
	(declare (type (unsigned-byte 32) x))
	(if (< x #x80000000)
	x
	(- x (ash 2 31))))

	(defun read-int32-le (stream)
	(word32->int32 (read-word32-le stream)))


	;;;
	;;; Ordering Buffer
	;;;

	(defparameter +quote-packet-data-size+ 214)

	(defparameter +quote-packet-size+ (+ +quote-packet-size+ 4))

	(defparameter +max-quote-packets+ 1024)

	(defstruct (ordering-buffer (:constructor %make-ordering-buffer))
	buffer
	newest
	oldest)

	(defun make-ordering-buffer ()
	(let ((buffer (make-array (* +max-quote-packets+ +quote-packet-size+)
	:element-type '(unsigned-byte 8)
	:initial-element #x00)))
	(%make-ordering-buffer :buffer buffer :newest 0 :oldest 0)))

	(defun ordering-buffer-index (i)
	(unless (and (<= 0 i)
	(< i +max-quote-packets+))
	(error "The value ~S is out of boundary of the ordering buffer." i))
	(* i +quote-packet-size+))

	(defun ordering-buffer-newest-index (buffer)
	(ordering-buffer-index (ordering-buffer-newest buffer)))

	(defun ordering-buffer-oldest-index (buffer)
	(ordering-buffer-index (ordering-buffer-oldest buffer)))

	(defun ordering-buffer-empty-p (buffer)
	(= (ordering-buffer-newest buffer)
	(ordering-buffer-oldest buffer)))

	(defun ordering-buffer-full-p (buffer)
	(let ((newest (ordering-buffer-newest buffer))
	(oldest (ordering-buffer-oldest buffer)))
	(when (< newest oldest)
	(incf newest +max-quote-packets+))
	(= (- newest oldest) (- +max-quote-packets+ 1))))

	(defun ordering-buffer-increment-newest (buffer)
	(unless (not (ordering-buffer-full-p buffer))
	(error "The ordering buffer is full."))
	(incf (ordering-buffer-newest buffer))
	(if (= +max-quote-packets+ (ordering-buffer-newest buffer))
	(setf (ordering-buffer-newest buffer) 0))
	buffer)

	(defun ordering-buffer-increment-oldest (buffer)
	(unless (not (ordering-buffer-empty-p buffer))
	(error "The ordering buffer is empty."))
	(incf (ordering-buffer-oldest buffer))
	(if (= +max-quote-packets+ (ordering-buffer-oldest buffer))
	(setf (ordering-buffer-oldest buffer) 0))
	buffer)

	(defun ordering-buffer-oldest-passed-four-seconds-p (buffer)
	(unless (not (ordering-buffer-empty-p buffer))
	(error "The ordering buffer is empty."))
	nil)

	(defun ordering-buffer-get-string (buffer i length)
	(coerce
	(loop repeat length
	for i0 from (ordering-buffer-index i)
	collect (code-char (aref (ordering-buffer-buffer buffer) i0)))
	'string))

	(defun ordering-buffer-get-int8 (buffer i)
	nil)

	(defun ordering-buffer-get-int16-le (buffer i)
	nil)

	(defun ordering-buffer-get-int32-le (buffer i)
	nil)

	(defun ordering-buffer-get-word8 (buffer i)
	nil)

	(defun ordering-buffer-get-word16-le (buffer i)
	nil)

	(defun ordering-buffer-get-word32-le (buffer i)
	(let ((buffer% (ordering-buffer-buffer buffer))
	(i0 (ordering-buffer-index i)))
	(+ (ash (aref buffer% (+ i0 3)) 24)
	(ash (aref buffer% (+ i0 2)) 16)
	(ash (aref buffer% (+ i0 1)) 8)
	(aref buffer% i0))))

	(defun ordering-buffer-data-type (buffer i)
	(ordering-buffer-get-string buffer i 2))

	(defun ordering-buffer-read-quote-packet (buffer stream)
	(unless (not (ordering-buffer-full-p buffer))
	(error "The ordering buffer is full."))
	;; read packet header

	;; read packet data with searching quote packet from stream
	(read-sequence (ordering-buffer-buffer buffer) stream
	:start (ordering-buffer-newest-index buffer)
	:end (+ (ordering-buffer-newest-index buffer)
	+quote-packet-data-size+))
	;; order by quote accept time

	;; update the newest pointer
	(ordering-buffer-increment-newest buffer))

	(defmacro ordering-buffer-do-quote-packet ((var buffer) &body body)
	;; TODO: once only buffer
	`(loop
	while (and (not (ordering-buffer-empty-p ,buffer))
	(ordering-buffer-oldest-passed-four-seconds-p ,buffer))
	do (let ((,var (ordering-buffer-oldest ,buffer)))
	,@body)
	(ordering-buffer-increment-oldest ,buffer)))

	(defun read-pcap-hdr (stream)
	(read-word32-le stream)
	(read-word16-le stream)
	(read-word16-le stream)
	(read-int32-le stream)
	(read-word32-le stream)
	(read-word32-le stream)
	(read-word32-le stream))

	(defun main ()
	(let ((buffer (make-ordering-buffer)))
	(with-open-file (in "data" :direction :input
	:element-type '(unsigned-byte 8))
	(read-pcap-hdr in)
	;; TODO: handling EOF?
	(handler-case
	(loop
	(ordering-buffer-read-quote-packet buffer in)
	(do-ordering-buffer-quote-packet (i buffer)
	(print-feed buffer i)))
	(end-of-file ()))
	(do-ordering-buffer-quote-packet-all (i buffer)
	(print-feed buffer i)))))