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 <jay.mccar...@gmail.com> 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 racket-users+unsubscr...@googlegroups.com.
For more options, visit https://groups.google.com/d/optout.
