suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

lru

Browse Source 
svn: r3529
This commit is contained in:
Jay McCarthy 2006-06-28 19:16:58 +00:00
parent 788d291b13
commit 929f2f5312
1 changed files with 27 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
collects/web-server/managers/lru.ss
View File

@ -1,5 +1,6 @@
(module lru mzscheme (module lru mzscheme
(require (lib "plt-match.ss")) (require (lib "plt-match.ss")
(lib "kw.ss"))
(require "manager.ss") (require "manager.ss")
(provide create-LRU-manager) (provide create-LRU-manager)
@ -14,9 +15,13 @@
; Private ; Private
instances instances
next-instance-id)) next-instance-id))
(define (create-LRU-manager (define/kw (create-LRU-manager
instance-expiration-handler instance-expiration-handler
collect?) time0 time1
collect?
#:key
[initial-count 1]
[inform-p (lambda _ (void))])
;; Instances ;; Instances
(define instances (make-hash-table)) (define instances (make-hash-table))
(define next-instance-id (make-counter)) (define next-instance-id (make-counter))
@ -68,7 +73,7 @@
(define salt (random 100000000)) (define salt (random 100000000))
(hash-table-put! htable (hash-table-put! htable
k-id k-id
(list salt k expiration-handler 1)) (list salt k expiration-handler initial-count))
(list k-id salt)])) (list k-id salt)]))
(define (continuation-lookup instance-id a-k-id a-salt) (define (continuation-lookup instance-id a-k-id a-salt)
(match (instance-lookup instance-id) (match (instance-lookup instance-id)
@ -131,17 +136,27 @@
(set-box! removed (add1 (unbox removed))) (set-box! removed (add1 (unbox removed)))
(hash-table-remove! instances instance-id))]))) (hash-table-remove! instances instance-id))])))
(unless (zero? (unbox removed)) (unless (zero? (unbox removed))
#;(printf "Collect: ~S ~S~n" (inform-p (unbox removed))
(unbox removed)
(round (/ (current-memory-use)
(* 1024 1024))))
(collect-garbage) (collect-garbage)
(collect-garbage))) (collect-garbage)))
(define manager-thread (define manager-thread
(thread (thread
(lambda () (lambda ()
(let loop () (define (seconds->msecs s)
(collect) (+ (current-inexact-milliseconds)
(loop))))) (* s 1000)))
(let loop ([msecs0 (seconds->msecs time0)]
[msecs1 (seconds->msecs time1)])
(sync (handle-evt
(alarm-evt msecs0)
(lambda _
(when (collect?)
(collect))
(loop (seconds->msecs time0) msecs1)))
(handle-evt
(alarm-evt msecs1)
(lambda _
(collect)
(loop msecs0 (seconds->msecs time1)))))))))
the-manager)) the-manager))