mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +02:00
Code Activity

reverse order of poll-set traversal in http-read

Browse source 
* module/web/server/http.scm (http-read): Rewrite to iterate down the
  pollset, so the vector shuffles touch less memory and the end
  condition of the loop is clearer.
This commit is contained in:
Andy Wingo 2010-12-03 16:11:37 +01:00
parent 462a1a04cf
commit 0baead3f6e
1 changed files with 50 additions and 52 deletions
Download patch file Download diff file Expand all files Collapse all files

46
module/web/server/http.scm
View file

@ -60,52 +60,50 @@
(sigaction SIGPIPE SIG_IGN) (sigaction SIGPIPE SIG_IGN)
(let ((poll-set (make-empty-poll-set))) (let ((poll-set (make-empty-poll-set)))
(poll-set-add! poll-set socket *events*) (poll-set-add! poll-set socket *events*)
(make-http-server socket 1 poll-set))) (make-http-server socket 0 poll-set)))
;; -> (client request body | #f #f #f) ;; -> (client request body | #f #f #f)
(define (http-read server) (define (http-read server)
(let* ((poll-set (http-poll-set server))) (let* ((poll-set (http-poll-set server)))
(let lp ((idx (http-poll-idx server))) (let lp ((idx (http-poll-idx server)))
(cond
((not (< idx (poll-set-nfds poll-set)))
(poll poll-set)
(lp 0))
(else
(let ((revents (poll-set-revents poll-set idx))) (let ((revents (poll-set-revents poll-set idx)))
(cond (cond
((zero? revents)
;; Nothing on this port.
(lp (1+ idx)))
((zero? idx) ((zero? idx)
;; The server socket. ;; The server socket, and the end of our downward loop.
(if (not (zero? (logand revents *error-events*))) (cond
((zero? revents)
;; No client ready, and no error; poll and loop.
(poll poll-set)
(lp (1- (poll-set-nfds poll-set))))
((not (zero? (logand revents *error-events*)))
;; An error. ;; An error.
(throw 'interrupt) (throw 'interrupt))
;; Otherwise, we have a new client. Add to set, then (else
;; find another client that is ready to read. ;; A new client. Add to set, poll, and loop.
;; ;;
;; FIXME: preserve meta-info. ;; FIXME: preserve meta-info.
(let ((client (accept (poll-set-port poll-set idx)))) (let ((client (accept (poll-set-port poll-set idx))))
;; Set line buffering while reading the request. ;; Set line buffering while reading the request.
(setvbuf (car client) _IOLBF) (setvbuf (car client) _IOLBF)
(poll-set-add! poll-set (car client) *events*) (poll-set-add! poll-set (car client) *events*)
(lp (1+ idx))))) (poll poll-set)
(lp (1- (poll-set-nfds poll-set)))))))
((zero? revents)
;; Nothing on this port.
(lp (1- idx)))
;; Otherwise, a client socket with some activity on ;; Otherwise, a client socket with some activity on
;; it. Remove it from the poll set. ;; it. Remove it from the poll set.
(else (else
(let ((port (poll-set-remove! poll-set idx))) (let ((port (poll-set-remove! poll-set idx)))
(cond (cond
((or (not (zero? (logand revents *error-events*))) ((eof-object? (peek-char port))
(eof-object? (peek-char port))) ;; EOF.
;; The socket was shut down or had an error. See
;; http://www.greenend.org.uk/rjk/2001/06/poll.html
;; for an interesting discussion.
(close-port port) (close-port port)
(lp idx)) (lp (1- idx)))
(else (else
;; Otherwise, try to read a request from this port. ;; Otherwise, try to read a request from this port.
;; Next time we start with this index. ;; Record the next index.
(set-http-poll-idx! server idx) (set-http-poll-idx! server (1- idx))
(call-with-error-handling (call-with-error-handling
(lambda () (lambda ()
(let ((req (read-request port))) (let ((req (read-request port)))
@ -119,7 +117,7 @@
#:post-error #:post-error
(lambda (k . args) (lambda (k . args)
(warn "Error while reading request" k args) (warn "Error while reading request" k args)
(values #f #f #f)))))))))))))) (values #f #f #f))))))))))))
(define (keep-alive? response) (define (keep-alive? response)
(let ((v (response-version response))) (let ((v (response-version response)))