diff --git a/scheme/httpd/surflets/packages.scm b/scheme/httpd/surflets/packages.scm index d4eba02..20bffef 100644 --- a/scheme/httpd/surflets/packages.scm +++ b/scheme/httpd/surflets/packages.scm @@ -260,6 +260,9 @@ rt-structure-binding load-structure)) +(define-interface with-locks-interface + (export with-lock)) + ;; With the help of TYPED-OPTIONALS you can define a function ;; like (make-submit-button [string] args) (define-interface typed-optionals-interface @@ -375,9 +378,10 @@ locks ;MAKE-LOCK et al. profiling ;PROFILE-SPACE rt-module-language ;get structures dynamically - search-trees scheme-with-scsh ;regexp et al. + search-trees shift-reset ;SHIFT and RESET + (subset srfi-1 (alist-cons alist-delete!)) srfi-6 ;string-ports srfi-14 ;CHAR-SET:DIGIT srfi-27 ;random numbers @@ -389,7 +393,7 @@ thread-safe-counter threads ;SLEEP uri ;URI-PATH-LIST->PATH - (subset srfi-1 (alist-cons alist-delete!)) + with-locks ;WITH-LOCK ) (files surflet-handler)) @@ -636,3 +640,8 @@ package-commands-internal) (files rt-module)) +(define-structure with-locks with-locks-interface + (open scheme + locks) + (files with-locks)) + diff --git a/scheme/httpd/surflets/surflet-handler.scm b/scheme/httpd/surflets/surflet-handler.scm index bd1472e..7931671 100644 --- a/scheme/httpd/surflets/surflet-handler.scm +++ b/scheme/httpd/surflets/surflet-handler.scm @@ -149,15 +149,6 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; doesn't belong to here... -(define (with-lock lock thunk) - (dynamic-wind - (lambda () - (obtain-lock lock)) - thunk - (lambda () - (release-lock lock)))) - ;;; RESUME-URL ;; Resumes a suspended URL and returns a (HTTP-)RESPONSE. PATH-STRING ;; is the virtual path, SURFLET-PATH a string pointing to the real diff --git a/scheme/httpd/surflets/with-locks.scm b/scheme/httpd/surflets/with-locks.scm new file mode 100644 index 0000000..a3b6181 --- /dev/null +++ b/scheme/httpd/surflets/with-locks.scm @@ -0,0 +1,10 @@ +;; From sunterlib + +(define (with-lock lock thunk) + (dynamic-wind + (lambda () + (obtain-lock lock)) + thunk + (lambda () + (release-lock lock)))) +