syndicate-lang
/
minimart-benchmark-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

syndicate-js and racket-evt variations

This commit is contained in:
Tony Garnock-Jones 2019-06-21 14:41:39 +01:00
parent ac46f5cdba
commit 63146632fe
2 changed files with 82 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
external-latency.rkt
View File

@ -30,7 +30,11 @@
["--imperative-syndicate+tcp"
"use imperative-syndicate server with TCP driver"
(set! server-variation 'imperative-syndicate+tcp)]
["--racket" "use plain racket server" (set! server-variation 'racket)]
["--syndicate-js"
"use Syndicate/js"
(set! server-variation 'syndicate-js)]
["--racket" "use threaded racket server" (set! server-variation 'racket)]
["--racket-evt" "use evented racket server" (set! server-variation 'racket-evt)]
["--other" name "use other server" (set! server-variation name)])
(when (not server-variation)
@ -69,6 +73,7 @@
['prospect+tcp (format-racket-server-command-line "echo-server-prospect-tcp-driver.rkt")]
['imperative-syndicate+tcp (format-racket-server-command-line "echo-server-imperative-syndicate-tcp-driver.rkt")]
['racket (format-racket-server-command-line "plain-racket-server.rkt")]
['racket-evt (format-racket-server-command-line "plain-racket-server-evt.rkt")]
['erlang
(define erlang-version-command
"erl -noshell -eval 'io:format(erlang:system_info(otp_release)), halt().'")
@ -79,6 +84,8 @@
['uv
(write-logbook-datum! Tmachine #:label "uv-banner" (capture-output "./uvserver -v"))
"./uvserver"]
['syndicate-js
"node echo-server-syndicate-js.js"]
[(? string? other)
(printf "Please start the other server on hostname '~a' now.\n" server-hostname)
(printf "Press enter when it has started.\n")

74
plain-racket-server-evt.rkt Normal file
View File

@ -0,0 +1,74 @@
#lang racket/base
(require racket/match)
(require racket/tcp)
(require racket/port)
(require logbook)
(require racket/cmdline)
;; (define server-entry-name #f)
;; (define server-entry-type #f)
;; (command-line #:program "plain-racket-server-evt.rkt"
;; #:once-each
;; ["--logbook-entry-name" name
;; "set logbook entry name to use when recording run statistics"
;; (set! server-entry-name name)]
;; ["--logbook-entry-type" type
;; "set logbook entry type to use"
;; (set! server-entry-type type)])
;; (when (not server-entry-type)
;; (error 'plain-racket-server "Please supply the --logbook-entry-type command-line argument."))
;; (define L (default-logbook))
;; (define E (logbook-entry L "minimart" server-entry-name server-entry-type))
;; (define Tmem (logbook-table E "server-memory-use" #:column-spec '(time-seconds memory-use)))
;; (define Tconn (logbook-table E "server-connections" #:column-spec '(time-seconds connection-count)))
(define connection-count 0)
(define first-connection-seen? #f)
(define statistics-poll-interval 2000)
(void (thread
(lambda ()
(let loop ()
(sleep (/ statistics-poll-interval 1000.0))
(printf "~a connections\n" connection-count)
(flush-output)
(define now (current-inexact-milliseconds))
;; (write-logbook-datum! Tmem (list (/ now 1000.0) (current-memory-use)))
;; (write-logbook-datum! Tconn (list (/ now 1000.0) connection-count))
(when (and first-connection-seen? (zero? connection-count))
;; (close-logbook L)
(exit 0))
(loop)))))
(define (connection in out)
(set! connection-count (+ connection-count 1))
(set! first-connection-seen? #t)
(define reader-evt
(handle-evt (read-line-evt in 'any)
(lambda (item)
(match item
[(? eof-object?)
(close-input-port in)
(close-output-port out)
(set! connection-count (- connection-count 1))
(lambda (events) (remq reader-evt events))]
[line
(fprintf out "~a\n" line)
(flush-output out)
values]))))
(lambda (events) (cons reader-evt events)))
(define (listener port-number)
(define s (tcp-listen port-number 128 #t))
(let loop ((events (list (handle-evt (tcp-accept-evt s)
(lambda (ports)
(match-define (list in out) ports)
(connection in out))))))
(loop ((or (apply sync/timeout 1.0 events) values) events))))
(listener 5999)