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

[Kim F. Storm]

Jason Rumney <address@hidden> writes:

> "Eli Zaretskii" <address@hidden> writes:
> 
> > > From: David Kastrup <address@hidden>
> > > 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 <address@hidden> http://www.cua.dk