On 17/08/15 15:02, Tim Brown wrote:
> I am observing a memory leak with place-channels. I have long-lived (or
> very busy server “places” ) which I think are exhausting VM memory and
> causing spectacular failures -- core dumps, spins and other fun I came
> to Racket to avoid. Please could someone more familiar with the code
> take a look at this?
To explain my need of insane numbers of places, I have a web-server
similar to the one below being served by a “farm” of server-places,
which all listen to a common place-channel on which requests are made.
Each request contains a reply-to place-channel so the server-place can
reply.
Since the web-server is multi-threaded, each thread (spun up ad-hoc to
service an HTTP client) needs a place-channel pair to be created
ad-hoc[*]. So a place-channel is created for each request.
Load testing this caused some strange errors. Which can’t be being
helped by the leak I mention in my original mail.
Eventually, I’ll want to use distributed places to spread the load
more thinly. But, as I say, I want to have confidence in local place-
channels first.
[*] Commented out in the example code is code to reuse place-channels
from a “pool”, which won’t leak place-channels.
-----------------------------------------------------------------------
#lang racket/base
(require racket/place)
(provide server-place)
(define (server-place pl)
(define my-id (place-channel-get pl))
(define bcast-read-ch (place-channel-get pl))
(displayln (format "place ~s loading" my-id))
(place-channel-put pl (format "~s standing by" my-id))
(let loop ()
(define rply (place-channel-get bcast-read-ch))
(define reply-to-pch (car rply))
(define n (cadr rply))
(place-channel-put reply-to-pch (list my-id n (add1 n)))
(unless (zero? n)
(loop)))
(printf "~s shut down~%" my-id))
(module main racket/base
(require web-server/servlet-env
racket/place
syntax/location
web-server/http/response-structs)
(define n-servers
(begin
6 ;; I thought this was too much!
1 ;; fails after 17,000 with "Racket virtual machine has run out
;; of memory; aborting"
2 ;; fails after 8,000 with "SIGSEGV MAPERR si_code 1 fault on
;; addr 0x7ffcf1726f78"
))
(define-values (bcast-to-ch bcast-from-ch)
(place-channel))
(define my-servers
(for/list ((id (in-range 1 (add1 n-servers))))
(define srv-pl (dynamic-place (quote-module-path "..")
'server-place))
(place-channel-put srv-pl id)
(place-channel-put srv-pl bcast-from-ch)
srv-pl))
;; Get server “hello” messages. Also syncs web-server for start
(for ((srv-pl my-servers))
(define msg (place-channel-get srv-pl))
(displayln msg)
msg)
(define (start req)
(when #t
(define-values (reply-read-ch reply-write-ch)
(place-channel))
(define i (add1 (random 1000)))
(place-channel-put bcast-to-ch (list reply-write-ch i))
(define rply (place-channel-get reply-read-ch))
(void))
(response/full 200 #"OK" (current-seconds)
TEXT/HTML-MIME-TYPE null '(#"<h1>A response</h1>")))
#|
(define place-channel-pool
(for/list ((i 20))
(define-values (to-ch from-ch) (place-channel))
(cons to-ch from-ch)))
(define place-channel-pool-sem (make-semaphore 20))
(define place-channel-pool-mux (make-semaphore 1))
(define (pool:place-channel)
(semaphore-wait place-channel-pool-sem)
(semaphore-wait place-channel-pool-mux)
(define rv-pair (car place-channel-pool))
(set! place-channel-pool (cdr place-channel-pool))
(semaphore-post place-channel-pool-mux)
(values (car rv-pair) (cdr rv-pair)))
(define (pool:replace-channel t f)
(semaphore-wait place-channel-pool-mux)
(set! place-channel-pool (cons (cons t f) place-channel-pool))
(semaphore-post place-channel-pool-mux)
(semaphore-post place-channel-pool-sem))
(define (start req)
(when #t
(define-values (reply-read-ch reply-write-ch)
(pool:place-channel))
(define i (add1 (random 1000)))
(place-channel-put bcast-to-ch (list reply-write-ch i))
(define rply (place-channel-get reply-read-ch))
(pool:replace-channel reply-read-ch reply-write-ch)
(void))
(response/full 200 #"OK" (current-seconds)
TEXT/HTML-MIME-TYPE null '(#"<h1>A response</h1>")))
|#
(define (test-1)
(serve/servlet
start
#:port 8881
#:listen-ip #f
#:stateless? #f ; or #t ... doesn't matter
#:servlet-regexp #rx""
#:launch-browser? #f))
(test-1))
-----------------------------------------------------------------------
Tim Brown
--
Tim Brown CEng MBCS <tim.br...@cityc.co.uk>
━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
City Computing Limited · www.cityc.co.uk
City House · Sutton Park Rd · Sutton · Surrey · SM1 2AE · GB
T:+44 20 8770 2110 · F:+44 20 8770 2130
────────────────────────────────────────────────────────────────────────
City Computing Limited registered in London No:1767817.
Registered Office: City House, Sutton Park Road, Sutton, Surrey, SM1 2AE
VAT No: GB 918 4680 96
--
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.
