scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

use shift/reset

This commit is contained in:
interp 2002-09-14 16:42:24 +00:00
parent 04b7adbd89
commit 4ae31efbb2
1 changed files with 19 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
scheme/httpd/surflets/surflet-handler.scm
View File

@ -54,15 +54,15 @@
(define (launch-new-instance full-path req) (define (launch-new-instance full-path req)
(let ((instance-id (generate-new-instance-id)) (let ((instance-id (generate-new-instance-id))
(plugin (get-plugin-rt-structure full-path))) (plugin (get-plugin-rt-structure full-path)))
(call-with-current-continuation (reset
(lambda (return) (begin
(save-instance! full-path instance-id) ; make entry in instance-table (save-instance! full-path instance-id) ; make entry in instance-table
(register-session! instance-id return) (register-session! instance-id 'no-return)
(with-names-from-rt-structure (with-names-from-rt-structure
plugin plugin-interface plugin plugin-interface
;; MAIN may return in another thread, so we have to lookup ;; MAIN may return in another thread, so we have to lookup
;; return continuation explicitly ;; return continuation explicitly
((session-return-continuation) (main req))))))) (main req))))))
;; try to get continuation-table and then the continuation ;; try to get continuation-table and then the continuation
(define (resume-url full-path req) (define (resume-url full-path req)
@ -82,28 +82,27 @@ You can try starting at the <A HREF=~a>beginning</a>."
(let* ((continuation-table (instance-continuation-table instance-id)) (let* ((continuation-table (instance-continuation-table instance-id))
(resume (table-ref continuation-table continuation-id))) (resume (table-ref continuation-table continuation-id)))
(if resume (if resume
(call-with-current-continuation (reset
(lambda (return) (begin
(register-session! instance-id return) (register-session! instance-id 'no-return)
(error "This may never return." ; for debugging ; (error "This may never return." ; for debugging
(resume req)))))))))))) (resume req)))))))))))
(define (send/suspend response-maker) (define (send/suspend response-maker)
(call-with-current-continuation (shift return
(lambda (return) (let* ((instance-id (session-instance-id))
(let* ((instance-id (session-instance-id)) (continuations-table (instance-continuation-table instance-id))
(continuations-table (instance-continuation-table instance-id)) (continuation-id (generate-new-continuation-id instance-id)))
(continuation-id (generate-new-continuation-id instance-id))) (table-set! continuations-table continuation-id return)
(table-set! continuations-table continuation-id return) (let ((new-url (make-resume-url (instance-servlet-name instance-id)
(let ((new-url (make-resume-url (instance-servlet-name instance-id) instance-id
instance-id continuation-id)))
continuation-id))) (response-maker new-url)))))
((session-return-continuation) (response-maker new-url)))))))
(define (send/finish response) (define (send/finish response)
(instance-delete (session-instance-id)) (instance-delete (session-instance-id))
((session-return-continuation) response)) response)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; access to instance-table ;; access to instance-table