On 5/19/06, Daishi Kato <[EMAIL PROTECTED]> wrote:
Hi,
I too have noticed this problem while I was modifying
http-client.scm. ngrep (or tcpdump) shows
several packets for even a small http request/response.
This could have been solved by buffering in http-client,
but the better solution I imagined was also to buffer
at tcp port level, which I'm not sure how to code it.
Yes, I could see how input buffering would be useful as well.
Attached is the output-buffer definition I came up with -- could
probably use some improvements, but it does seem to solve the
small-message-related problems I've been seeing here. Thanks to Thomas
for the fast substring-set! implementation.
Defining a macro:
(define-macro (with-buffered-output bufsize . body)
`(with-output-to-port
(output-buffer (current-output-port) ,bufsize)
(lambda ()
,@body
(flush-output))))
-- where 'body' would include the loop for persistent connections --
makes it pretty simple to adapt existing code. A buffer-size of 1500
would match the MTU on most systems, and still seems to work well on a
loopback connection.
Graham
;;; output-buffer: wrap an output-port in a buffer.
;;; can be used to optimize outbound network traffic.
;;; Graham Fawcett, Thomas Chust.
(define (output-buffer target-port #!optional (buffer-size 1500))
(unless (output-port? target-port)
(error 'output-buffer "not an output port!"))
(let* ((buf (make-string buffer-size))
(buffer-pos 0))
(define (write-buffered s)
(let ((len (string-length s)))
(if (>= (+ buffer-pos len) buffer-size) ; too big for buffer?
;; write the buffer, then s.
(begin (flush-buffer)
(write-string s #f target-port))
;; else, buffer s.
(begin (substring-set! buf s buffer-pos)
(set! buffer-pos (+ buffer-pos len))))))
(define (flush-buffer)
(when (> buffer-pos 0)
(write-string (substring buf 0 buffer-pos) #f target-port)
(set! buffer-pos 0))
(flush-output target-port))
(define (close-buffer)
(flush-buffer)
(close-output-port target-port) ; seems the right thing to do.
(set! buf #f))
(make-output-port write-buffered close-buffer flush-buffer)))
;;; substring-set! -- an interpreted and a much faster compiled version.
#+ csi
(define (substring-set! buffer replace start #!optional (count #f))
(let ((buffer-size (string-length buffer))
(replace-len (string-length replace)))
(let loop ((current 0))
(let ((buffer-pos (+ current start)))
(when (and (< current replace-len)
(< buffer-pos buffer-size)
(if count (< current count) #t))
(string-set! buffer buffer-pos (string-ref replace current))
(loop (add1 current)))))))
; from Thomas Chust
#+ (not csi)
(define (substring-set! buffer replace
#!optional (start 0)
(count (string-length replace)))
(if (or (< start 0)
(< count 0)
(> start (string-length buffer))
(> count (string-length replace))
(> count (- (string-length buffer) start)))
(error 'substring-set!
"start and/or count parameters have bad values"
buffer replace start count))
((foreign-lambda* void ((scheme-pointer buffer)
(scheme-pointer replace)
(integer start) (integer count))
"memmove(buffer + start, replace, count);")
buffer replace start count))
_______________________________________________
Chicken-users mailing list
[email protected]
http://lists.nongnu.org/mailman/listinfo/chicken-users
