diff --git a/scheme/httpd/surflets/surflet-handler.scm b/scheme/httpd/surflets/surflet-handler.scm
index 1e5dd9d..a7e7e88 100644
--- a/scheme/httpd/surflets/surflet-handler.scm
+++ b/scheme/httpd/surflets/surflet-handler.scm
@@ -45,6 +45,9 @@
(http-syslog (syslog-level debug)
"servlet-handler: clearing plugin cache")
(reset-plugin-cache!)
+ (http-syslog (syslog-level debug)
+ "servlet-handler: clearing instance table")
+ (reset-instance-table!))
(make-http-error-response http-status/accepted req "plugin cache cleared"))
((or (string=? request-method "GET")
; (string=? request-method "POST")) ; do this at later time
@@ -123,7 +126,7 @@ You can try starting at the beginning."
))))
-(define (send-html/suspend html-tree-maker)
+(define (send/suspend response-maker)
(shift return
(let* ((instance-id (session-instance-id))
(instance (instance-lookup instance-id))
@@ -138,28 +141,12 @@ You can try starting at the beginning."
instance-id
continuation-counter
continuation-id)))
- (make-usual-html-response
- (lambda (out options)
- (with-current-output-port*
- out
- (lambda () (SXML->HTML (html-tree-maker new-url)))))))))))
+ (response-maker new-url))))))
+
-(define (send-html/finish html-tree)
+(define (send/finish response)
(instance-delete! (session-instance-id))
- (make-usual-html-response
- (lambda (out options)
- (with-current-output-port* ; FIXME: will change in further revision
- out
- (lambda () (SXML->HTML html-tree))))))
-
-(define (make-usual-html-response writer-proc)
- (make-response
- http-status/ok
- (status-code->text http-status/ok)
- (time)
- "text/html"
- '()
- (make-writer-body writer-proc)))
+ response)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; access to instance-table
@@ -238,6 +225,16 @@ You can try starting at the beginning."
(set! *plugin-table* (make-string-table))
(release-lock *plugin-table-lock*))))
+(define (reset-instance-table!)
+ (with-fatal-error-handler
+ (lambda (condtion decline)
+ (release-lock *instance-table-lock*)
+ (decline))
+ (lambda ()
+ (obtain-lock *instance-table-lock*)
+ (set! *instance-table* (make-integer-table))
+ (release-lock *instance-table*))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SESSION
(define *session* (make-thread-cell #f))