I thought of another way, so here's a fourth version:
#lang racket/base
(require racket/tcp
racket/match
racket/place)
(define message #"Lorem ipsum...") ;; XXX fill this in
(define len (bytes-length message))
(define (serve! r w)
(let read-loop ()
(define b (read-bytes-line r 'any))
(unless (or (eof-object? b) (bytes=? b #""))
(read-loop)))
(close-input-port r)
(write-bytes #"HTTP/1.1 200 OK\r\n" w)
(write-bytes #"Connection: close\r\n" w)
(write-string (format "Content-Length: ~a\r\n" len) w)
(write-bytes #"\r\n" w)
(write-bytes message w)
(close-output-port w))
(define port-no 5000)
(define (setup! k)
(define l (tcp-listen port-no 500 #t "0.0.0.0"))
(k l)
(tcp-close l))
(define (single-at-a-time l)
(let loop ()
(define-values (r w) (tcp-accept l))
(serve! r w)
(loop)))
(define (many-at-a-time l)
(let loop ()
(define-values (r w) (tcp-accept l))
(thread (λ () (serve! r w)))
(loop)))
(define (k-places l)
(define-values (jobs-ch-to jobs-ch-from) (place-channel))
(define ps
(for/list ([i (in-range (processor-count))])
(place/context
local-ch
(let loop ()
(define r*w (place-channel-get jobs-ch-from))
(serve! (car r*w) (cdr r*w))
(loop)))))
(let loop ()
(define-values (r w) (tcp-accept l))
(place-channel-put jobs-ch-to (cons r w))
(loop)))
(define (many-places l)
(define ps
(for/list ([i (in-range (processor-count))])
(place/context
jobs-ch-from
(let loop ()
(define r*w (place-channel-get jobs-ch-from))
(thread (λ () (serve! (car r*w) (cdr r*w))))
(loop)))))
(let loop ()
(for ([send-to-p-ch (in-list ps)])
(define-values (r w) (tcp-accept l))
(place-channel-put send-to-p-ch (cons r w)))
(loop)))
(module+ main
(setup!
(match (current-command-line-arguments)
[(vector "single")
single-at-a-time]
[(vector "many")
many-at-a-time]
[(vector "places")
k-places]
[(vector "many-places")
many-places])))
On Mon, Sep 4, 2017 at 5:11 PM, Jay McCarthy <[email protected]> wrote:
> Thank you for working on this Danyil. I think it is fair to test what
> the defaults give you.
>
> Would you please add this file to your tests (and each of its three
> ways of running?) It would be interesting to compare the performance
> of Racket versus the particular Web server library. (The Web server
> sets up a lot of safety state per connection to ensure that each
> individual connection doesn't run out of memory or crash anything. I
> am curious what the cumulative effect of all those features and
> protections are.)
>
> Jay
>
> #lang racket/base
> (require racket/tcp
> racket/match)
>
> (define message #"Lorem ipsum...") ;; XXX fill this in
> (define len (bytes-length message))
>
> (define (serve! r w)
> (let read-loop ()
> (define b (read-bytes-line r 'any))
> (unless (or (eof-object? b) (bytes=? b #""))
> (read-loop)))
> (close-input-port r)
> (write-bytes #"HTTP/1.1 200 OK\r\n" w)
> (write-bytes #"Connection: close\r\n" w)
> (write-string (format "Content-Length: ~a\r\n" len) w)
> (write-bytes #"\r\n" w)
> (write-bytes message w)
> (close-output-port w))
>
> (define port-no 5000)
> (define (setup! k)
> (define l (tcp-listen port-no 500 #t "0.0.0.0"))
> (k l)
> (tcp-close l))
>
> (define (single-at-a-time l)
> (let loop ()
> (define-values (r w) (tcp-accept l))
> (serve! r w)
> (loop)))
>
> (define (many-at-a-time l)
> (let loop ()
> (define-values (r w) (tcp-accept l))
> (thread (λ () (serve! r w)))
> (loop)))
>
> (define (k-places l)
> (local-require racket/place)
>
> (define-values (jobs-ch-to jobs-ch-from) (place-channel))
> (define ps
> (for/list ([i (in-range (processor-count))])
> (place/context
> local-ch
> (let loop ()
> (define r*w (place-channel-get jobs-ch-from))
> (serve! (car r*w) (cdr r*w))
> (loop)))))
>
> (let loop ()
> (define-values (r w) (tcp-accept l))
> (place-channel-put jobs-ch-to (cons r w))
> (loop)))
>
> (module+ main
> (setup!
> (match (current-command-line-arguments)
> [(vector "single")
> single-at-a-time]
> [(vector "many")
> many-at-a-time]
> [(vector "places")
> k-places])))
>
> --
> -=[ Jay McCarthy http://jeapostrophe.github.io ]=-
> -=[ Associate Professor PLT @ CS @ UMass Lowell ]=-
> -=[ Moses 1:33: And worlds without number have I created; ]=-
--
-=[ Jay McCarthy http://jeapostrophe.github.io ]=-
-=[ Associate Professor PLT @ CS @ UMass Lowell ]=-
-=[ Moses 1:33: And worlds without number have I created; ]=-
--
You received this message because you are subscribed to the Google Groups
"Racket Users" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to [email protected].
For more options, visit https://groups.google.com/d/optout.
