Update of /project/imago/cvsroot/imago/src In directory common-lisp.net:/tmp/cvs-serv22907
Modified Files: file-png.lisp Log Message: Little optimization of memory allocation in READ-PNG Date: Tue Oct 19 08:26:02 2004 Author: mvilleneuve
Index: imago/src/file-png.lisp diff -u imago/src/file-png.lisp:1.1.1.1 imago/src/file-png.lisp:1.2 --- imago/src/file-png.lisp:1.1.1.1 Thu Oct 14 00:01:53 2004 +++ imago/src/file-png.lisp Tue Oct 19 08:26:02 2004 @@ -29,7 +29,10 @@ :element-type '(unsigned-byte 8)) (read-png-signature stream) (let ((descriptor nil) - (data (make-array 0 :element-type '(unsigned-byte 8) :adjustable t)) + (data (make-array (file-length stream) + :element-type '(unsigned-byte 8) :adjustable t + :fill-pointer 0)) + (data-index 0) (colormap nil)) (loop for chunk = (read-png-chunk stream) until (= (car chunk) +png-iend-chunk-type+) @@ -39,10 +42,10 @@ (setf colormap (decode-png-colormap (cdr chunk)))) ((= (car chunk) +png-idat-chunk-type+) (let* ((chunk-data (cdr chunk)) - (chunk-length (length chunk-data)) - (data-length (length data))) - (adjust-array data (+ data-length chunk-length)) - (replace data chunk-data :start1 data-length))))) + (chunk-length (length chunk-data))) + (incf (fill-pointer data) chunk-length) + (replace data chunk-data :start1 data-index) + (incf data-index chunk-length))))) (when (or (/= (png-descriptor-compression-method descriptor) 0) (/= (png-descriptor-filter-method descriptor) 0) (/= (png-descriptor-interlace-method descriptor) 0))