From 5c0698e07d7036ad948f6872043fb578afb65fa3 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Wed, 13 Jun 2007 01:22:46 +0000 Subject: [PATCH] Removing manager locking svn: r6618 --- .../dispatchers/dispatch-servlets.ss | 26 +++--- .../web-server/docs/reference/managers.scrbl | 5 -- collects/web-server/managers/lru.ss | 90 +++++++++---------- collects/web-server/managers/manager.ss | 4 - collects/web-server/managers/none.ss | 7 -- collects/web-server/managers/timeouts.ss | 22 ++--- 6 files changed, 61 insertions(+), 93 deletions(-) diff --git a/collects/web-server/dispatchers/dispatch-servlets.ss b/collects/web-server/dispatchers/dispatch-servlets.ss index f2fb6dfce9..7f2ed3c9d1 100644 --- a/collects/web-server/dispatchers/dispatch-servlets.ss +++ b/collects/web-server/dispatchers/dispatch-servlets.ss @@ -99,16 +99,10 @@ (define manager (servlet-manager the-servlet)) (parameterize ([current-execution-context (make-execution-context req)]) (define instance-id ((manager-create-instance manager) (make-servlet-instance-data servlet-mutex) (exit-handler))) - ; XXX Locking is broken - ((manager-instance-lock! manager) instance-id) - (parameterize ([current-servlet-instance-id instance-id] - [exit-handler (lambda (v) - ((manager-instance-unlock! manager) instance-id) - (exit v))]) - (begin0 (with-handlers ([(lambda (x) #t) - (make-servlet-exception-handler)]) - ((servlet-handler the-servlet) req)) - ((manager-instance-unlock! manager) instance-id)))))))) + (parameterize ([current-servlet-instance-id instance-id]) + (with-handlers ([(lambda (x) #t) + (make-servlet-exception-handler)]) + ((servlet-handler the-servlet) req)))))))) servlet-prompt))))) (output-response conn response)) @@ -138,11 +132,16 @@ (define the-servlet (cached-load servlet-path)) (define manager (servlet-manager the-servlet)) (define data ((manager-instance-lookup-data manager) instance-id)) - (define _v ((manager-instance-lock! manager) instance-id)) (define response (parameterize ([current-servlet the-servlet] + [current-directory (get-servlet-base-dir servlet-path)] [current-servlet-instance-id instance-id] - [current-custodian (servlet-custodian the-servlet)]) + [current-custodian (servlet-custodian the-servlet)] + [current-namespace (servlet-namespace the-servlet)] + [exit-handler + (lambda (v) + (kill-connection! conn) + (custodian-shutdown-all (servlet-custodian the-servlet)))]) (with-handlers ([exn:fail:servlet-manager:no-instance? (lambda (the-exn) ((exn:fail:servlet-manager:no-instance-expiration-handler the-exn) req))] @@ -161,8 +160,7 @@ (define kcb ((manager-continuation-lookup manager) instance-id k-id salt)) ((custodian-box-value kcb) req)) servlet-prompt))))))) - (output-response conn response) - ((manager-instance-unlock! manager) instance-id)) + (output-response conn response)) ;; cached-load : path -> script, namespace ;; timestamps are no longer checked for performance. The cache must be explicitly diff --git a/collects/web-server/docs/reference/managers.scrbl b/collects/web-server/docs/reference/managers.scrbl index bd087718a0..110adc98a7 100644 --- a/collects/web-server/docs/reference/managers.scrbl +++ b/collects/web-server/docs/reference/managers.scrbl @@ -22,8 +22,6 @@ the users and implementers of managers. @defstruct[manager ([create-instance (any/c (-> void) . -> . number?)] [adjust-timeout! (number? number? . -> . void)] [instance-lookup-data (number? . -> . any/c)] - [instance-lock! (number? . -> . void)] - [instance-unlock! (number? . -> . void)] [clear-continuations! (number? . -> . void)] [continuation-store! (number? any/c expiration-handler? . -> . (list/c number? number?))] [continuation-lookup (number? number? number? . -> . any/c)])]{ @@ -40,9 +38,6 @@ the users and implementers of managers. @scheme[instance-lookup-data] accesses the arbitrary data passed into @scheme[create-instance] match by the given instance-id. - @scheme[instance-lock!] and @scheme[instance-unlock!] lock and unlock - access to a particular instance. - @scheme[clear-continuations!] expires all the continuations of an instance. @scheme[continuation-store!] is given an instance-id, a continuation value, diff --git a/collects/web-server/managers/lru.ss b/collects/web-server/managers/lru.ss index f0a37ff489..f2cdbc1485 100644 --- a/collects/web-server/managers/lru.ss +++ b/collects/web-server/managers/lru.ss @@ -25,16 +25,17 @@ #:key [initial-count 1] [inform-p (lambda _ (void))]) + (define lock (make-semaphore 1)) ;; Instances (define instances (make-hash-table)) (define next-instance-id (make-counter)) - (define-struct instance (data k-table use-count)) + (define-struct instance (data k-table)) (define (create-instance data expire-fn) (define instance-id (next-instance-id)) (hash-table-put! instances instance-id - (make-instance data (create-k-table) 0)) + (make-instance data (create-k-table))) instance-id) (define (adjust-timeout! instance-id secs) (void)) @@ -49,15 +50,6 @@ instance-expiration-handler))))) instance) - (define (instance-lock! instance-id) - (define instance (instance-lookup instance-id)) - (set-instance-use-count! instance - (add1 (instance-use-count instance)))) - (define (instance-unlock! instance-id) - (define instance (instance-lookup instance-id)) - (set-instance-use-count! instance - (sub1 (instance-use-count instance)))) - ;; Continuation table (define-struct k-table (next-id-fn htable)) (define (create-k-table) @@ -69,7 +61,7 @@ (define (clear-continuations! instance-id) (match (instance-lookup instance-id) - [(struct instance (data (and k-table (struct k-table (next-id-fn htable))) locked?)) + [(struct instance (data (and k-table (struct k-table (next-id-fn htable))))) (hash-table-for-each htable (match-lambda* @@ -79,7 +71,7 @@ (define (continuation-store! instance-id k expiration-handler) (match (instance-lookup instance-id) - [(struct instance (data (struct k-table (next-id-fn htable)) _)) + [(struct instance (data (struct k-table (next-id-fn htable)))) (define k-id (next-id-fn)) (define salt (random 100000000)) (hash-table-put! htable @@ -88,7 +80,7 @@ (list k-id salt)])) (define (continuation-lookup instance-id a-k-id a-salt) (match (instance-lookup instance-id) - [(struct instance (data (struct k-table (next-id-fn htable)) _)) + [(struct instance (data (struct k-table (next-id-fn htable)))) (match (hash-table-get htable a-k-id (lambda () @@ -109,15 +101,17 @@ instance-expiration-handler))) k)])])) + (define (wrap f) + (lambda args + (call-with-semaphore lock (lambda () (apply f args))))) + (define the-manager - (make-LRU-manager create-instance + (make-LRU-manager (wrap create-instance) adjust-timeout! - instance-lookup-data - instance-lock! - instance-unlock! - clear-continuations! - continuation-store! - continuation-lookup + (wrap instance-lookup-data) + (wrap clear-continuations!) + (wrap continuation-store!) + (wrap continuation-lookup) ; Specific instance-expiration-handler ; Private @@ -126,32 +120,34 @@ ; Collector (define (collect just-go?) - (define removed (box 0)) - (hash-table-for-each - instances - (match-lambda* - [(list instance-id (struct instance (_ (struct k-table (next-id-fn htable)) use-count))) - (define empty? (box #t)) - (hash-table-for-each - htable - (match-lambda* - [(list k-id (list s k eh count)) - (if (zero? count) - (begin (set-box! removed (add1 (unbox removed))) - (hash-table-remove! htable k-id)) - (begin (set-box! empty? #f) - (hash-table-put! htable k-id - (list s k eh (sub1 count)))))])) - (when (and (unbox empty?) - ; XXX race condition - (zero? use-count)) - (set-box! removed (add1 (unbox removed))) - (hash-table-remove! instances instance-id))])) - (when (or just-go? - (not (zero? (unbox removed)))) - (inform-p (unbox removed)) - (collect-garbage) - (collect-garbage))) + (call-with-semaphore + lock + (lambda () + (define removed (box 0)) + (hash-table-for-each + instances + (match-lambda* + [(list instance-id (struct instance (_ (struct k-table (next-id-fn htable))))) + (define empty? (box #t)) + (hash-table-for-each + htable + (match-lambda* + [(list k-id (list s k eh count)) + (if (zero? count) + (begin (set-box! removed (add1 (unbox removed))) + (hash-table-remove! htable k-id)) + (begin (set-box! empty? #f) + (hash-table-put! htable k-id + (list s k eh (sub1 count)))))])) + (when (unbox empty?) + (set-box! removed (add1 (unbox removed))) + (hash-table-remove! instances instance-id))])) + (when (or just-go? + (not (zero? (unbox removed)))) + (inform-p (unbox removed)) + (collect-garbage) + (collect-garbage))))) + (define manager-thread (thread (lambda () diff --git a/collects/web-server/managers/manager.ss b/collects/web-server/managers/manager.ss index ca60addead..0d95878d9c 100644 --- a/collects/web-server/managers/manager.ss +++ b/collects/web-server/managers/manager.ss @@ -5,8 +5,6 @@ (define-struct manager (create-instance adjust-timeout! instance-lookup-data - instance-lock! - instance-unlock! clear-continuations! continuation-store! continuation-lookup)) @@ -18,8 +16,6 @@ [struct manager ([create-instance (any/c (any/c . -> . void) . -> . number?)] [adjust-timeout! (number? number? . -> . void)] [instance-lookup-data (number? . -> . any/c)] - [instance-lock! (number? . -> . void)] - [instance-unlock! (number? . -> . void)] [clear-continuations! (number? . -> . void)] [continuation-store! (number? any/c expiration-handler? . -> . (list/c number? number?))] [continuation-lookup (number? number? number? . -> . any/c)])] diff --git a/collects/web-server/managers/none.ss b/collects/web-server/managers/none.ss index 9d2d887067..f2f170f656 100644 --- a/collects/web-server/managers/none.ss +++ b/collects/web-server/managers/none.ss @@ -22,11 +22,6 @@ (current-continuation-marks) instance-expiration-handler))) - (define (instance-lock! instance-id) - (void)) - (define (instance-unlock! instance-id) - (void)) - (define (instance-lookup-data instance-id) (thread-cell-ref the-data)) @@ -41,8 +36,6 @@ (make-none-manager create-instance adjust-timeout! instance-lookup-data - instance-lock! - instance-unlock! clear-continuations! continuation-store! continuation-lookup diff --git a/collects/web-server/managers/timeouts.ss b/collects/web-server/managers/timeouts.ss index 7f91ff1169..6113eb69cd 100644 --- a/collects/web-server/managers/timeouts.ss +++ b/collects/web-server/managers/timeouts.ss @@ -28,7 +28,7 @@ (define instances (make-hash-table)) (define next-instance-id (make-counter)) - (define-struct instance (data k-table timer locked?)) + (define-struct instance (data k-table timer)) (define (create-instance data expire-fn) (define instance-id (next-instance-id)) (hash-table-put! instances @@ -38,8 +38,7 @@ (start-timer instance-timer-length (lambda () (expire-fn) - (hash-table-remove! instances instance-id))) - #t)) + (hash-table-remove! instances instance-id))))) instance-id) (define (adjust-timeout! instance-id secs) (reset-timer! (instance-timer (instance-lookup instance-id)) @@ -56,14 +55,7 @@ (increment-timer! (instance-timer instance) instance-timer-length) instance) - - (define (instance-lock! instance-id) - (define instance (instance-lookup instance-id)) - (set-instance-locked?! instance #t)) - (define (instance-unlock! instance-id) - (define instance (instance-lookup instance-id)) - (set-instance-locked?! instance #f)) - + ;; Continuation table (define-struct k-table (next-id-fn htable)) (define (create-k-table) @@ -75,7 +67,7 @@ (define (clear-continuations! instance-id) (match (instance-lookup instance-id) - [(struct instance (data (and k-table (struct k-table (next-id-fn htable))) instance-timer locked?)) + [(struct instance (data (and k-table (struct k-table (next-id-fn htable))) instance-timer)) (hash-table-for-each htable (match-lambda* @@ -85,7 +77,7 @@ (define (continuation-store! instance-id k expiration-handler) (match (instance-lookup instance-id) - [(struct instance (data (struct k-table (next-id-fn htable)) instance-timer locked?)) + [(struct instance (data (struct k-table (next-id-fn htable)) instance-timer)) (define k-id (next-id-fn)) (define salt (random 100000000)) (hash-table-put! htable @@ -99,7 +91,7 @@ (list k-id salt)])) (define (continuation-lookup instance-id a-k-id a-salt) (match (instance-lookup instance-id) - [(struct instance (data (struct k-table (next-id-fn htable)) instance-timer locked?)) + [(struct instance (data (struct k-table (next-id-fn htable)) instance-timer)) (match (hash-table-get htable a-k-id (lambda () @@ -123,8 +115,6 @@ (make-timeout-manager create-instance adjust-timeout! instance-lookup-data - instance-lock! - instance-unlock! clear-continuations! continuation-store! continuation-lookup