diff --git a/scheme/httpd/surflets/bindings.scm b/scheme/httpd/surflets/bindings.scm index e08289d..637b0e5 100644 --- a/scheme/httpd/surflets/bindings.scm +++ b/scheme/httpd/surflets/bindings.scm @@ -5,7 +5,7 @@ ;; a later GET-BINDINGS call on the same POST request. The requests ;; are referenced by a weak pointer. Thread-safe as all threads use ;; the same lock. -(define *POST-bindings-cache* '(#f)) +(define *POST-bindings-cache* '()) (define *cache-lock* (make-lock)) (define (get-bindings surflet-request) @@ -54,20 +54,29 @@ (define (cached-bindings surflet-request) (obtain-lock *cache-lock*) (let ((result - (let loop ((cache *POST-bindings-cache*)) - (let ((tail (cdr cache))) - (if (null? tail) ; cache has at least one element + (let loop ((predecessor #f) + (cache *POST-bindings-cache*)) + (if (null? cache) #f ; no such request cached - (let* ((head (car tail)) + (let* ((head (car cache)) (s-req (weak-pointer-ref (car head)))) (if s-req (if (eq? s-req surflet-request) (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 - ;; it from list - (set-cdr! cache (cdr tail)) - (loop cache))))))))) + ;; it from list + (if predecessor + (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*) result))