bug reading single bit binary data

[ferrante@world.std.com (Richard D Ferrante)]

I have encountered a problem when trying to read moderate sized (> 4K
sample) single bit (unsigned-byte 1) binary arrays from files in MCL
2.0 final. 

Essentially the file pointer begins to wrap at about 4096 samples and
begins rereading data. A sample function with debug output follow.  

I haven't seen similar problems with 8 bit files.

--- 

Richard Ferrante
(617)-254-5451
ferrante@world.std.com
    

(defun read-tiff-image (full-path)
  (let ((new-image (make-instance 'tiff-image))
        header 
        bits-per-pixel
        input-element
        image-array
        offset-factor
        offset-position)
    (setq header (read-tiff-header full-path))
    (setf (slot-value new-image 'header) header)
    (setq bits-per-pixel (* (slot-value header 'bits-per-sample) (slot-value header 'samples-per-pixel)))
    (case bits-per-pixel
      (1 (setq input-element '(unsigned-byte 1)) (setq offset-factor 8))
      (8 (setq input-element '(unsigned-byte 8)) (setq offset-factor 1))
      (16 (setq input-element '(unsigned-byte 16)) (setq offset-factor .5))
      
      (t (error "unsupported bits per sample of ~x(x) ~d(d)" bits-per-pixel bits-per-pixel)))
    (setf (slot-value new-image 'equivalent-data-type) input-element)
    (setq image-array (make-array (list (slot-value header 'image-length)
                                        (slot-value header 'image-width) 
                                        )
                                  :element-type input-element))
    (setf (slot-value new-image 'image-arrays) image-array)
    (with-open-file (in-stream full-path :direction :input :element-type input-element)
      ;;first seek to the appropriate location
      (cond ((null (listp (slot-value header 'strip-offsets))) ;;only one chunk
             (setq offset-position (* (slot-value header 'strip-offsets) offset-factor))
             (format t "~% setting offset to ~d or ~d bytes: type ~a" 
                     offset-position (slot-value header 'strip-offsets) input-element)
             (file-position in-stream offset-position)
             (format t "~% array ~a" image-array)
             (format t "~% row limit ~a col limit ~a" 
                     (slot-value header 'rows-per-strip) (slot-value header 'image-width))
             (loop for row from 0 below (slot-value header 'rows-per-strip)
                   with position and desired-position
                   do
                   (setq position (file-position in-stream))
                   (setq desired-position (+ offset-position (* row (slot-value header 'image-width))))
                   (format t "~% file position ~a,desired ~a ok ~a" 
                           position desired-position (= position desired-position))
                   (when (/= position desired-position)
                     (file-position in-stream desired-position)
                     (setq position (file-position in-stream))
                     (setq desired-position (+ offset-position (* row (slot-value header 'image-width))))
                     (format t "~% TEST 2 file position ~a,desired ~a ok ~a" 
                             position desired-position (= position desired-position)))
                   (loop for col from 0 below (slot-value header 'image-width) 
                         do
                         (setf (aref image-array row col) (read-byte in-stream))))
             
             
             
             
             )
            (t
             (error "multiple rows per strip not yet supported"))))
    (values new-image)))


The initial few lines of degub output look like this
 setting offset to 1392 or 174 bytes: type (UNSIGNED-BYTE 1)
 array #<ARRAY 449x480 type BIT, simple>
 row limit 449 col limit 480
 file position 1392,desired 1392 ok T
 file position 1872,desired 1872 ok T
 file position 2352,desired 2352 ok T
 file position 2832,desired 2832 ok T
 file position 3312,desired 3312 ok T
 file position 3792,desired 3792 ok T
 file position 688,desired 4272 ok NIL
 TEST 2 file position 4272,desired 4272 ok T
 file position 1168,desired 4752 ok NIL
 TEST 2 file position 4752,desired 4752 ok T
 file position 1648,desired 5232 ok NIL
 TEST 2 file position 5232,desired 5232 ok T
 file position 2128,desired 5712 ok NIL
 TEST 2 file position 5712,desired 5712 ok T
 file position 2608,desired 6192 ok NIL
 TEST 2 file position 6192,desired 6192 ok T
 file position 3088,desired 6672 ok NIL
 TEST 2 file position 6672,desired 6672 ok T
 file position 7152,desired 7152 ok T
 file position 4048,desired 7632 ok NIL
 TEST 2 file position 7632,desired 7632 ok T
 file position 4528,desired 8112 ok NIL
 TEST 2 file position 8112,desired 8112 ok T
 file position 5008,desired 8592 ok NIL
 TEST 2 file position 8592,desired 8592 ok T
 file position 5488,desired 9072 ok NIL
 TEST 2 file position 9072,desired 9072 ok T
 file position 5968,desired 9552 ok NIL
 TEST 2 file position 9552,desired 9552 ok T
 file position 6448,desired 10032 ok NIL
 TEST 2 file position 10032,desired 10032 ok T
 file position 6928,desired 10512 ok NIL


As expected, even using the reset position hack, the image which is
read in still looks wrong although not as wrong as before.