Adding a debugging interface to managers

svn: r16560

collects/web-server/managers/lru.ss

@@ -100,7 +100,7 @@
                   k-id
                   (list salt k expiration-handler initial-count))
        (list k-id salt)]))
-  (define (continuation-lookup instance-id a-k-id a-salt)
+  (define (continuation-lookup* instance-id a-k-id a-salt peek?)
     (match (instance-lookup instance-id)
       [(struct instance ((struct k-table (next-id-fn htable))))
        (match
@@ -111,8 +111,9 @@
                                (current-continuation-marks)
                                instance-expiration-handler))))
          [(list salt k expiration-handler count)
+          (unless peek?
             (hash-set! htable a-k-id
-                     (list salt k expiration-handler (add1 count)))
+                       (list salt k expiration-handler (add1 count))))
           (if (or (not (eq? salt a-salt))
                   (not k))
               (raise (make-exn:fail:servlet-manager:no-continuation
@@ -122,6 +123,10 @@
                           expiration-handler
                           instance-expiration-handler)))
               k)])]))
+  (define (continuation-lookup instance-id a-k-id a-salt)
+    (continuation-lookup* instance-id a-k-id a-salt #f))
+  (define (continuation-peek instance-id a-k-id a-salt)
+    (continuation-lookup* instance-id a-k-id a-salt #t))
   
   (define (wrap f)
     (lambda args
@@ -133,6 +138,7 @@
                       (wrap clear-continuations!)
                       (wrap continuation-store!)
                       (wrap continuation-lookup)
+                      (wrap continuation-peek)
                       ; Specific
                       instance-expiration-handler
                       ; Private

collects/web-server/managers/manager.ss

@@ -6,7 +6,8 @@
                         adjust-timeout!
                         clear-continuations!
                         continuation-store!
-                        continuation-lookup))
+                        continuation-lookup
+                        continuation-peek))
 
 (define-struct (exn:fail:servlet-manager:no-instance exn:fail) (expiration-handler))
 (define-struct (exn:fail:servlet-manager:no-continuation exn:fail) (expiration-handler))
@@ -16,7 +17,8 @@
                   [adjust-timeout! (number? number? . -> . void)]
                   [clear-continuations! (number? . -> . void)]
                   [continuation-store! (number? any/c expiration-handler/c . -> . (list/c number? number?))]
-                  [continuation-lookup (number? number? number? . -> . any/c)])]
+                  [continuation-lookup (number? number? number? . -> . any/c)]
+                  [continuation-peek (number? number? number? . -> . any/c)])]
  [struct (exn:fail:servlet-manager:no-instance exn:fail) 
          ([message string?]
           [continuation-marks continuation-mark-set?]

collects/web-server/managers/none.ss

@@ -33,5 +33,6 @@
                      clear-continuations!
                      continuation-store!
                      continuation-lookup
+                     continuation-lookup
                      ; Specific
                      instance-expiration-handler))

collects/web-server/managers/timeouts.ss

@@ -40,10 +40,10 @@
                                              (hash-remove! instances instance-id)))))
     instance-id)
   (define (adjust-timeout! instance-id secs)
-    (reset-timer! (instance-timer (instance-lookup instance-id))
+    (reset-timer! (instance-timer (instance-lookup instance-id #f))
                   secs))
   
-  (define (instance-lookup instance-id)
+  (define (instance-lookup instance-id peek?)
     (define instance
       (hash-ref instances instance-id
                 (lambda ()
@@ -51,8 +51,9 @@
                           (format "No instance for id: ~a" instance-id)
                           (current-continuation-marks)
                           instance-expiration-handler)))))
+    (unless peek?
       (increment-timer! (instance-timer instance)
-                      instance-timer-length)
+                        instance-timer-length))
     instance)
   
   ;; Continuation table
@@ -62,7 +63,7 @@
   
   ;; Interface    
   (define (clear-continuations! instance-id)
-    (match (instance-lookup instance-id)
+    (match (instance-lookup instance-id #f)
       [(struct instance ((and k-table (struct k-table (next-id-fn htable))) instance-timer))
        (hash-for-each
         htable
@@ -72,7 +73,7 @@
                       (list salt #f expiration-handler k-timer))]))]))
   
   (define (continuation-store! instance-id k expiration-handler)
-    (match (instance-lookup instance-id)
+    (match (instance-lookup instance-id #t)
       [(struct instance ((struct k-table (next-id-fn htable)) instance-timer))
        (define k-id (next-id-fn))
        (define salt (random 100000000))
@@ -85,8 +86,8 @@
                                                   (list salt #f expiration-handler
                                                         (start-timer 0 void)))))))
        (list k-id salt)]))
-  (define (continuation-lookup instance-id a-k-id a-salt)
-    (match (instance-lookup instance-id)
+  (define (continuation-lookup* instance-id a-k-id a-salt peek?)
+    (match (instance-lookup instance-id peek?)
       [(struct instance ((struct k-table (next-id-fn htable)) instance-timer))
        (match
            (hash-ref htable a-k-id
@@ -96,8 +97,9 @@
                                (current-continuation-marks)
                                instance-expiration-handler))))
          [(list salt k expiration-handler k-timer)
+          (unless peek?
             (increment-timer! k-timer
-                            continuation-timer-length)
+                              continuation-timer-length))
           (if (or (not (eq? salt a-salt))
                   (not k))
               (raise (make-exn:fail:servlet-manager:no-continuation
@@ -107,12 +109,17 @@
                           expiration-handler
                           instance-expiration-handler)))
               k)])]))
+  (define (continuation-lookup instance-id a-k-id a-salt)
+    (continuation-lookup* instance-id a-k-id a-salt #f))
+  (define (continuation-peek instance-id a-k-id a-salt)
+    (continuation-lookup* instance-id a-k-id a-salt #t))
   
   (make-timeout-manager create-instance 
                         adjust-timeout!
                         clear-continuations!
                         continuation-store!
                         continuation-lookup
+                        continuation-peek
                         ; Specific
                         instance-expiration-handler
                         instance-timer-length

collects/web-server/scribblings/managers.scrbl

@@ -24,7 +24,8 @@ the users and implementers of managers.
                     [adjust-timeout! (number? number? . -> . void)]
                     [clear-continuations! (number? . -> . void)]
                     [continuation-store! (number? any/c expiration-handler/c . -> . (list/c number? number?))]
-                    [continuation-lookup (number? number? number? . -> . any/c)])]{
+                    [continuation-lookup (number? number? number? . -> . any/c)]
+                    [continuation-peek (number? number? number? . -> . any/c)])]{
  @scheme[create-instance] is called to initialize a instance, to hold the
  continuations of one servlet session. It is passed
  a function to call when the instance is expired. It runs the id of the
@@ -43,6 +44,10 @@ the users and implementers of managers.
 
  @scheme[continuation-lookup] finds the continuation value associated with
  the instance-id, continuation-id, and nonce triple it is given.
+ 
+ @scheme[continuation-peek] is identical to @scheme[continuation-lookup] except that
+ its use must not affect the resource management policy decisions on the instance or
+ continuation accessed. It is intended to be used by debuggers and benchmarks.
 }
 
 @defstruct[(exn:fail:servlet-manager:no-instance exn:fail)