Re: LispM's crummy I/O performance (was RE: LispM Market Share)

[alanr@MEDIA-LAB.MEDIA.MIT.EDU]

      Now, anyone who has touched UNIX knows that reading in a 5meg file and
      even allocating memory for 1 million tokens (which are represented as
      integers) takes on the order of a few minutes (at most).  The LispM
      took almost over 5 hours to read in the data set!  This is on a 3650
      under 7.2.  What's more, the same LispM took almost 48 hours to dump
      the data (via NFS to a disk on a SUN4)!
      The ironic part of this is the CM took only about 15 seconds to
      actually process the data.

      I solved the same problem using C without the connection machine.  In
      fact, on a HP Series 800, the serial solution takes only a few hours,
      and it would take under an hour if not for paging problems at runtime.

      I think that 1meg/hr is not an acceptable I/O rate.

      -- David Magerman (magerman@linc.cis.upenn.edu)
      University of Pennsylvania LINC Laboratory

Given this horror story, I suppose that I should chip in with an io story
that is somewhat more reasonable.

I also use the connection machine, and needed to get access to ~ 1megabyte tiff
image files from a networked server. These needed to be converted to
symbolics rasters (so I could display them) and then downloaded to the cm.

While my initial implementation was slow (order of several minutes), I was
able to improve it substantially, to the point that I was getting a
throughput of around 50k bytes per second over ethernet, comparable to ftp
between the unix hosts.

Basically the improvement came when I shifted to block oriented transfers,
first reading the whole file into a stack array to avoid consing, and
processing it from there using array registers to loop through the data
quickly. I think that the performance is something like a 1 meg file,
including translation to raster image takes about 30 seconds over the net.
Not wonderful, but not 5 hours either. By the way, my experience in dumping 
was that if I use the sys:dump-form-to-file facility, and then load, my
binary files save
and load in a reasonable amount of time.

What this points out is that it is possible to get better performence than
you would expect, but that you have to do more work for it. This is
unfortunate, true, since one could hope that fast file transfer is so
pervasive that symbolics would have worked this out for us so that we don't
have to know the grungy details.

On the whole though, I find that when I program in C I have to write *all*
my code at this level of goriness, whereas on the symbolics I have to write
only critical sections this way.

By the way I rewrote the routines which transfer bit arrays to the cm for
the same reason.  I wanted more performence than the generic software would
give me. (the basic idea was to transfer the array down as a smaller 32bit array
since the cm io path is 32 bits wide, and then spread it out on the cm into
a 1 bit array. This reduced the time from 10s of seconds to about 5).

Perhaps symbolics should supply something like a block file read

(read-block file start-position end-position destination-array)

which does what the code below essentially does, and which is optimized for
just this case of large file transfers. For that matter, maybe it should be
in common lisp: I am now trying to figure out how to do the same thing on a
macintosh in allegro.

FYI here is the tight part of the code, with no apologies of course, for
its ugliness. The second function illustrates another speed hackish type
operation I use alot, operating on a larger word displaced array, instead
of a smaller word array.

----- Here is some ugly, but perhaps informative, code.

(defun to-image (filename &optional (image-name (pathname-name
filename)) &aux (bit-reversed-bytes *bit-reversed-bytes*))
  (declare (sys:array-register bit-reversed-bytes) (sys:array-register-1d bytemap))
  (with-tiff-context
    (with-open-file (f filename :element-type '(unsigned-byte 8))
      (eating-header f
	(grok-ifd f)
	(eval
	  (accept-from-string 'cp:command (format nil "Set Stack Size
Data ~A" (floor (* 1.1 (/ (file-length f) 4))))))
	(stack-let ((a (make-array (file-length f) :element-type
'(unsigned-byte 8)))
		    (current 0))
	  (declare (sys:array-register a))
	  (file-position f 0)
	  (loop 
	    (multiple-value-bind (buf start end)
		(send f :read-input-buffer)
	      (when (null buf) (return))
	      (copy-array-portion buf start end a current (incf current
(- end start)))
	      (send f :advance-input-buffer)))
	  (let* ((width (tiff-eval 'image-width))
		 (height (tiff-eval 'image-height))
		 (bytes-per-row (ceiling width 8))
		 (bytemap-bytes-per-row (* 4 (ceiling width 32)))
		 (image (possibly-reuse-image image-name width height))
		 (bitmap (send image :data-array))
		 (bytemap (make-array (list height bytemap-bytes-per-row)
					 :element-type '(unsigned-byte
8) :displaced-to bitmap))
		 (invert? (if (eq (tiff-eval
'photometric-interpretation) 'maximum-is-black) -1 0))
		 (bufptr (1- (tiff-eval 'strip-offsets))))
	    (sys:page-in-array bytemap nil nil nil)
	    (loop 
	      (multiple-value-bind (buf start end)
		  (send f :read-input-buffer)
		(when (null buf) (return))
		(copy-array-portion buf start end a current (incf
current (- end start)))
		(send f :advance-input-buffer)))
	    (zero-image bitmap)
	    (loop for row from 0 below height do 
	      (loop for %1dindex from (array-row-major-index bytemap row 0)
		    repeat bytes-per-row
		    do (sys:%1d-aset (logxor (aref bit-reversed-bytes
(aref a (incf bufptr))) invert?) bytemap %1dindex))
		  finally (return-from to-image image))))))))

(defun zero-image (array)
  (let ((displaced-array (make-array (/ (* (array-total-size array)
(sys:array-element-byte-size array)) 32)
		      :element-type '(unsigned-byte 32) :displaced-to array)))
  (fill displaced-array 0)))