Re: Fix for slow process output processing (please test).

[storm@cua.dk (Kim F. Storm)]

Jason Rumney <jasonr@gnu.org> writes:

> "Eli Zaretskii" <eliz@elta.co.il> writes:
> 
> > > From: David Kastrup <dak@gnu.org>
> > > Date: 05 Jan 2004 16:57:14 +0100
> > > > 
> > > > I suppose that process-adaptive-read-buffering isn't really needed
> > > > on Windows,
> > > 
> > > Since Windows is slow, anyway?
> > 
> > I think the reason is that Windows never feeds Emacs with such small
> > chunks from a pipe.
> 
> Maybe, but my understanding was that big chunks would still be
> reasonably fast using the new code, so we should try to find
> out. Perhaps there is a bug in our version of select that does not
> handle this situation properly, or perhaps the new buffering code needs
> further improvements.

With the code below (provided by David some time ago), I see a big
difference on the Linux 2.4 kernel I'm using (Redhat 9.0).

Maybe someone can try it (just do M-x make-test) with and without
adaptive buffering enabled on windows.


(defvar test-pattern nil)
(defvar test-start nil)

(defun test-filter (process string printer)
  (push (cons (floor (- (float-time) test-start))
	      (length string)) test-pattern)
  (princ string printer))

(defun test-predicate (a b)
  (if (equal (car a) (car b))
      (< (cdr a) (cdr b))
    (< (car a) (car b))))

(defun test-sentinel (process string printer finish)
  (princ string printer)
  (delete-process process)
  (setq test-pattern (sort test-pattern #'test-predicate))
  (let (elt lastelt lastcount)
    (while
	(prog1
	    (setq elt (pop test-pattern))
	  (if (equal lastelt elt)
	      (when lastelt (setq lastcount (1+ lastcount)))
	    (when lastelt
	      (princ (format "%4d blocks with size %4d\n"
			     lastcount (cdr lastelt)) printer))
	    (setq lastcount 1)))
      (when (not (eq (car lastelt) (car elt)))
	(princ (format "Time:%3d\n" (car elt)) printer))
      (setq lastelt elt)))
  (if finish (funcall finish)))

(defun make-test (printer &optional finish)
  (interactive (let ((buffer (get-buffer-create "*test*")))
		  (switch-to-buffer buffer)
		  (erase-buffer)
		  (list buffer)))
  (setq test-pattern nil test-start (float-time))
  (let ((process (start-process
		  "test" (and (bufferp printer) printer) "sh"
		  "-c" "od -v /dev/zero|dd bs=1 count=100k")))
    (set-process-filter process `(lambda (process string)
				   (test-filter process string
						',printer)))
    (set-process-sentinel process `(lambda (process string)
				     (test-sentinel process string
						    ',printer ',finish)))
    process))



-- 
Kim F. Storm <storm@cua.dk> http://www.cua.dk