[armedbear-ticket] [armedbear] #305: Slow writing to binary streams

[armedbear]

#305: Slow writing to binary streams
-------------------------+--------------------------------------------------
 Reporter:  sboukarev    |       Owner:  mevenson
     Type:  enhancement  |      Status:  new     
 Priority:  minor        |   Milestone:          
Component:  streams      |     Version:          
 Keywords:               |  
-------------------------+--------------------------------------------------
 Slow writing to binary streams


 {{{
 (defun test ()
   (with-open-file (stream "/dev/null" :direction :output
                                       :if-exists :overwrite
                                       :element-type '(unsigned-byte 8))
     (time (loop repeat 10000000 do (write-byte 23 stream)))))
 }}}


 (test)

 2.065 seconds real time
 30000260 cons cells

 The problem boils down to write-byte doing (typep 23 '(unsigned-byte 8)),
 and typep calls normalize-type, which conses a new type each time: (list
 'integer 0 (1- (expt 2 8)))

 http://trac.common-
 lisp.net/armedbear/browser/trunk/abcl/src/org/armedbear/lisp/byte-
 io.lisp#L34
 http://trac.common-
 lisp.net/armedbear/browser/trunk/abcl/src/org/armedbear/lisp/early-
 defuns.lisp#L155

 Just changing that part to

 {{{

 (UNSIGNED-BYTE
  (return-from normalize-type
    (if (or (null i) (eq (car i) '*))
        '(integer 0 *)
        (case (car i)
          (8 '(integer 0 255))
          (16 '(integer 0 65535))
          (32 '(integer 0 4294967295))
          (64 '(integer 0 18446744073709551615))
          (t
           (list 'integer 0 (1- (expt 2 (car i)))))))))
 }}}


 gives
 (test)
 1.682 seconds real time
 45 cons cells

 But even better solution would be to assign efficient writing and reading
 routines to streams during a stream creation. When I change the body of
 write-byte to

 {{{
 (defun write-byte (byte pstream)
   (declare (type stream stream))
   (write-8-bits byte stream))
 }}}


 I get
 (test)
 0.521 seconds real time
 12 cons cells

 And by extension this problem also affects TYPEP,
 (time (typep 23 '(unsigned-byte 8))) => 3 cons cells
 (time (typep #(a) '(simple-vector 2))) => 5 cons cells

-- 
Ticket URL: <http://trac.common-lisp.net/armedbear/ticket/305>
armedbear <http://common-lisp.net/project/armedbear>
armedbear