+ thread-based *options*

+ INSTANCE-DELETE! --> DELETE-INSTANCE!
+ access to continuations (GET-CONTINUATIONS, DELETE-CONTINUATION!)

scheme/httpd/surflets/surflet-handler.scm

@@ -34,12 +34,26 @@
 		       set-session-return-continuation!))
 
 (define-record options
+  servlet-path
+  servlet-prefix
   (cache-servlets? #t)
   (instance-lifetime 600))		; in seconds
 
-(define *options* (make-options))
+(define *options* (make-thread-cell #f))
 ;(define *options-lock* (make-lock))   ; currently unused
 
+(define (make-fluid-selector selector)
+  (lambda () (selector (thread-cell-ref *options*))))
+(define (make-fluid-setter setter)
+  (lambda (value)
+    (setter (thread-cell-ref *options*) value)))
+(define options-servlet-path (make-fluid-selector options:servlet-path))
+(define options-servlet-prefix (make-fluid-selector options:servlet-prefix))
+(define options-cache-servlets? (make-fluid-selector options:cache-servlets?))
+(define options-instance-lifetime (make-fluid-selector options:instance-lifetime))
+(define set-options-cache-servlets? (make-fluid-setter set-options:cache-servlets?))
+(define set-options-instance-lifetime (make-fluid-setter set-options:instance-lifetime))
+
 (define *instance-table* (make-integer-table)) ; instance-id is index
 (define *instance-table-lock* (make-lock))
 
@@ -54,6 +68,7 @@
 ;; servlet-prefix gives virtual prefixed path to servlets
 (define (servlet-handler servlet-path servlet-prefix)
   (lambda (path req)
+    (thread-cell-set! *options* (make-options servlet-path servlet-prefix))
     (if (pair? path)			; need at least one element
 	(let ((request-method (request:method req))
 	      (path-string (uri-path-list->path path)))
@@ -110,13 +125,13 @@
 	  (register-session! instance-id 'no-return)
 	  (let ((servlet (with-fatal-error-handler*
 			 (lambda (condition decline)
-			   (instance-delete! instance-id)
+			   (delete-instance! instance-id)
 			   (decline)) 
 			 (lambda () 
 			   (get-servlet-rt-structure path-string servlet-path)))))
 	    (fork-thread (instance-surveillance instance-id
 						(+ (time)
-						   (options:instance-lifetime *options*))
+						   (options-instance-lifetime))
 						memo))
 	    (reset
 	     (begin
@@ -226,7 +241,7 @@
 					 "The URL refers to a servlet, whose instance is no longer alive.")))))
 
 (define (send/finish response)
-  (instance-delete! (session-instance-id))
+  (delete-instance! (session-instance-id))
   (shift unused response))
 
 (define (send response)
@@ -244,7 +259,7 @@
   (thread-safe-counter-next! 
    (instance-continuation-counter instance)))
 
-(define (instance-delete! instance-id)
+(define (delete-instance! instance-id)
   (obtain-lock *instance-table-lock*)
   ;; notify surveillance of instance being alread killed (prevents
   ;; surveillance of killing new instance that has the same number by
@@ -263,7 +278,7 @@
     ;; Do it this way: new values and then new message
     (set-memo:value memo 
 		    (+ (time) 
-		       (options:instance-lifetime *options*)))
+		       (options-instance-lifetime)))
     (set-memo:new-memo memo new-memo)
     ;; I don't think we need locking here. Do you agree?
     (set-instance-memo! instance new-memo)
@@ -294,6 +309,33 @@
      *instance-table*)
     (release-lock *instance-table-lock*)
     instances))
+
+(define (get-continuations instance-id)
+  (let ((instance (instance-lookup instance-id)))
+    (if instance
+	(let ((continuation-table-lock (instance-continuation-table-lock instance))
+	      (continuation-table (instance-continuation-table instance))
+	      (continuations '()))
+	  (obtain-lock continuation-table-lock)
+	  (table-walk
+	   (lambda (continuation-id continuation-entry)
+	     (set! continuations (cons (cons continuation-id continuation-entry)
+				       continuations)))
+	   continuation-table)
+	  (release-lock continuation-table-lock)
+	  continuations)
+	'())))
+
+(define (delete-continuation! instance-id continuation-id)
+  (let ((instance (instance-lookup instance-id)))
+    (if instance
+	(let ((continuation-table-lock (instance-continuation-table-lock instance))
+	      (continuation-table (instance-continuation-table instance))
+	      (continuations '()))
+	  (obtain-lock continuation-table-lock)
+	  (if (table-ref continuation-table continuation-id)
+	      (table-set! continuation-table continuation-id #f))
+	  (release-lock continuation-table-lock)))))
 	
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -335,7 +377,7 @@
 		       ;; only now the lock may be released
 		       (release-lock *servlet-table-lock*)))
 		 servlet-structure))))))
-    (if (options:cache-servlets? *options*)
+    (if (options-cache-servlets?)
 	(begin
 	  ;; The lock is only obtained and released, if servlets are
 	  ;; cached. LOAD-SERVLET gets the CACHED? parameter, so
@@ -436,15 +478,6 @@
 (define (resume-url? id-url)
   (regexp-search? *resume-url-regexp* id-url))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; access to options
-
-(define (set-instance-lifetime! new-lifetime)
-  (set-options:instance-lifetime *options* new-lifetime))
-
-(define (get-instance-lifetime)
-  (options:instance-lifetime *options*))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; thread-safe counter