really remove that POST-bindings-cache bug

This commit is contained in:
interp 2004-09-24 13:49:05 +00:00
parent 306d104c5b
commit 902a34ae01
1 changed files with 18 additions and 9 deletions

View File

@ -5,7 +5,7 @@
;; a later GET-BINDINGS call on the same POST request. The requests ;; a later GET-BINDINGS call on the same POST request. The requests
;; are referenced by a weak pointer. Thread-safe as all threads use ;; are referenced by a weak pointer. Thread-safe as all threads use
;; the same lock. ;; the same lock.
(define *POST-bindings-cache* '(#f)) (define *POST-bindings-cache* '())
(define *cache-lock* (make-lock)) (define *cache-lock* (make-lock))
(define (get-bindings surflet-request) (define (get-bindings surflet-request)
@ -54,20 +54,29 @@
(define (cached-bindings surflet-request) (define (cached-bindings surflet-request)
(obtain-lock *cache-lock*) (obtain-lock *cache-lock*)
(let ((result (let ((result
(let loop ((cache *POST-bindings-cache*)) (let loop ((predecessor #f)
(let ((tail (cdr cache))) (cache *POST-bindings-cache*))
(if (null? tail) ; cache has at least one element (if (null? cache)
#f ; no such request cached #f ; no such request cached
(let* ((head (car tail)) (let* ((head (car cache))
(s-req (weak-pointer-ref (car head)))) (s-req (weak-pointer-ref (car head))))
(if s-req (if s-req
(if (eq? s-req surflet-request) (if (eq? s-req surflet-request)
(cdr head) ; request is cached (cdr head) ; request is cached
(loop (cdr cache))) ; request isn't cached (loop (if predecessor
(cdr predecessor)
cache)
(cdr cache))) ; request isn't cached
(begin ;; request object is gone ==> remove (begin ;; request object is gone ==> remove
;; it from list ;; it from list
(set-cdr! cache (cdr tail)) (if predecessor
(loop cache))))))))) (set-cdr! predecessor (cdr cache))
(set! *POST-bindings-cache* (cdr cache)))
(loop predecessor
(cdr predecessor)))))))))
(format (current-error-port)
"POST-bindings-cache: ~S\n"
*POST-bindings-cache*)
(release-lock *cache-lock*) (release-lock *cache-lock*)
result)) result))