use with-lock instead of obtain-lock/release-lock

scheme/httpd/surflets/surflet-handler.scm

@@ -72,19 +72,19 @@
 			 (surflet-request-request s-req) path-string))
 
    ((string=? (file-name-extension path-string) ".scm")
-    (obtain-lock *session-table-lock*)
+    (receive (session-id lifetime)
-    ;; no access to session table until new session-id is saved
+	(with-lock *session-table-lock*
 	  (let ((session-id (generate-new-table-id *session-table*))
 		(lifetime (options-session-lifetime)))
 	    (table-set! *session-table* session-id
-		  (make-session path-string    ; used to make
+			(make-session path-string          ; used for redirections
-						; redirections to origin
 				      (make-integer-table) ; continuation table
 				      (make-lock)          ; continuation table lock
 				      (make-thread-safe-counter) ; continuation counter
 				      #f	                  ; session-data
 				      lifetime))
-      (release-lock *session-table-lock*)
+	    (values session-id lifetime)))
+      ;; no access to session table until new session-id is saved
       (register-instance! session-id)
       
       (with-fatal-error-handler
@@ -163,10 +163,8 @@
 	(lookup-continuation-table
 	  (lambda (session continuation-table continuation-id)
 	    (let ((continuation-table-lock (session-continuation-table-lock session)))
-	      (obtain-lock continuation-table-lock)
+	      (with-lock continuation-table-lock
-	      (let ((result (table-ref continuation-table continuation-id)))
+		(table-ref continuation-table continuation-id))))))
-		(release-lock continuation-table-lock)
-		result)))))
 
     (lambda (path-string surflet-path s-req)
       (receive (session-id continuation-id)
@@ -208,10 +206,11 @@
 		 (let ((continuations-table (session-continuation-table session))
 		       (continuation-table-lock (session-continuation-table-lock session))
 		       (continuation-counter (session-next-continuation-counter session)))
-		   (obtain-lock continuation-table-lock)
+		   (let ((continuation-id 		   
-		   (let ((continuation-id (generate-new-table-id continuations-table)))
+			  (with-lock continuation-table-lock
-		     (table-set! continuations-table continuation-id return)
+			    (let ((c-id (generate-new-table-id continuations-table)))
-		     (release-lock continuation-table-lock)
+			      (table-set! continuations-table c-id return)
+			      c-id))))
 		     (let ((new-url (make-resume-url (session-surflet-name session)
 						     session-id 
 						     continuation-counter
@@ -284,10 +283,8 @@
 ;; Looks up SESSION-ID in the *SESSION-TABLE* (locking) and returns
 ;; the SESSION record, if anby (#f otherwise).
 (define (session-lookup session-id)
-  (obtain-lock *session-table-lock*)
+  (with-lock *session-table-lock*
-  (let ((result (table-ref *session-table* session-id)))
+    (table-ref *session-table* session-id)))
-    (release-lock *session-table-lock*)
-    result))
 
 ;;; SESSION-NEXT-CONTINUATION-COUNTER
 ;; Increases the SESSION-CONTINUATION-COUNTER in the SESSION record by
@@ -300,7 +297,7 @@
 ;; Deletes the session indicated by its number SESSION-ID from the
 ;; *SESSION-TABLE* (locking).
 (define (delete-session! session-id)
-  (obtain-lock *session-table-lock*)
+  (with-lock *session-table-lock*
     ;; notify surveillance of session being alread killed (prevents
   ;; surveillance of killing new session that has the same number by
   ;; accident)
@@ -308,9 +305,11 @@
     (if session
 	(begin
 	  (timeout-queue-remove-session! session-id)
-	  (table-set! *session-table* session-id #f))))
+	  (table-set! *session-table* session-id #f))
 	;; else: somebody was faster than we
-  (release-lock *session-table-lock*))
+	))))
+
+
  
 ;;; SESSION-ADJUST-TIMEOUT!
 ;; Resets time-to-die of session indicated by its SESSION-ID number.
@@ -358,28 +357,26 @@
    (lambda (condtion decline)
      (release-lock *session-table-lock*)
      (decline))
-   (obtain-lock *session-table-lock*)
+   (with-lock *session-table-lock*
      ;; notify session killing
      (table-walk 
       (lambda (session-id session)
 	(timeout-queue-remove-session! session-id))
       *session-table*)
-   (set! *session-table* (make-integer-table))
+     (set! *session-table* (make-integer-table)))))
-   (release-lock *session-table*)))
 
 ;;; GET-SESSIONS
 ;; Returns a list of all active sessions in *SESSION-TABLE*
 ;; (locking). The list elements are pairs of session-id and session
 ;; record.
 (define (get-sessions)
-  (obtain-lock *session-table-lock*)
+  (with-lock *session-table-lock*
     (let ((sessions '()))
       (table-walk
        (lambda (session-id session-entry)
 	 (set! sessions (cons (cons session-id session-entry) sessions)))
        *session-table*)
-    (release-lock *session-table-lock*)
+      sessions)))
-    sessions))
 
 (define get-session session-lookup)
 
@@ -398,14 +395,13 @@
 	(let ((continuation-table-lock (session-continuation-table-lock session))
 	      (continuation-table (session-continuation-table session))
 	      (continuations '()))
-	  (obtain-lock continuation-table-lock)
+	  (with-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))
-	  continuations)
 	'())))
 
 ;;; DELETE-CONTINUATION
@@ -414,12 +410,11 @@
   (let ((session (session-lookup session-id)))
     (if session
 	(let ((continuation-table-lock (session-continuation-table-lock session)))
-	  (obtain-lock continuation-table-lock)
+	  (with-lock continuation-table-lock
 	    (let ((continuation-table (session-continuation-table session))
 		  (continuations '()))
 	      (if (table-ref continuation-table continuation-id)
-		(table-set! continuation-table continuation-id #f)))
+		  (table-set! continuation-table continuation-id #f))))))))
-	  (release-lock continuation-table-lock)))))
 
 ;;; SET-SESSION-DATA!, GET-SESSION-DATA
 ;; Access to arbitrary data stored along with current session (no
@@ -462,13 +457,6 @@
 (define get-surflet-rt-structure
   (let ((load-surflet 
 	 (lambda (full-surflet-name cached?)
-	   ;; Want to get warnings also.
-	   (with-fatal-handler*
-	    (lambda (condition decline)
-	      (if cached? (release-lock *surflet-table-lock*))
-	      ;; Let the others do the job.
-	      (error condition))
-	    (lambda ()
 	   ;; load-config-file does not care about cwd(?)
 	   ;; --> absolute file name needed
 	   (load-config-file full-surflet-name)
@@ -476,31 +464,21 @@
 	   (let ((surflet-structure (reify-structure 'surflet)))
 	     (load-structure surflet-structure)
 	     (if cached?
-		    (begin
 		 (table-set! *surflet-table* full-surflet-name 
 			     (cons surflet-structure
-					(file-last-mod full-surflet-name)))
+				   (file-last-mod full-surflet-name))))
-		      ;; only now the lock may be released
+	     surflet-structure))))
-		      (release-lock *surflet-table-lock*)))
-		surflet-structure))))))
 
     (lambda (surflet-name directory)
       (let ((full-surflet-name (absolute-file-name surflet-name directory)))
 	(if (options-cache-surflets?)
-	    (begin
+	    (with-lock *surflet-table-lock*
-	      ;; The lock is only obtained and released, if surflets
-	      ;; are cached. LOAD-SURFLET gets the CACHED? parameter,
-	      ;; so nothing will happen, if in the meanwhile caching
-	      ;; is turned off.
-	      (obtain-lock *surflet-table-lock*)
 	      (cond
 	       ((table-ref *surflet-table* full-surflet-name) =>
 		(lambda (surflet)
 		  (if (equal? (file-last-mod full-surflet-name) 
 			      (cdr surflet))
-			(begin
+		      (car surflet)
-			  (release-lock *surflet-table-lock*)
-			  (car surflet))
 		      (load-surflet full-surflet-name #t))))
 	       (else
 		(load-surflet full-surflet-name #t))))
@@ -509,33 +487,26 @@
 ;;; GET-LOADED-SURFLETS
 ;; Returns list of all loaded surflets (real path strings).
 (define (get-loaded-surflets)
-  (obtain-lock *surflet-table-lock*)
+  (with-lock *surflet-table-lock*
     (let ((loaded-surflets '()))
       (table-walk
        (lambda (surflet-path rt-structure)
 	 (set! loaded-surflets (cons surflet-path loaded-surflets)))
        *surflet-table*)
-    (release-lock *surflet-table-lock*)
+      loaded-surflets)))
-    loaded-surflets))
 
 ;;; UNLOAD-SURFLET
 ;; Removes SURFLET-NAME from the *SURFLET-TABLE* cache (locking).
 (define (unload-surflet surflet-name)
-  (obtain-lock *surflet-table-lock*)
+  (with-lock *surflet-table-lock*
     (if (table-ref *surflet-table* surflet-name)
-      (table-set! *surflet-table* surflet-name #f))
+	(table-set! *surflet-table* surflet-name #f))))
-  (release-lock *surflet-table-lock*))
 
 ;;; RESET-SURFLET-CACHE!
 ;; Clears *SURFLET-TABLE* (locking).
 (define (reset-surflet-cache!)
-;  (with-fatal-handler
+  (with-lock *surflet-table-lock*
-;   (lambda (condition decline)
+    (set! *surflet-table* (make-string-table))))
-;     (release-lock *surflet-table-lock*)
-;     (decline))
-   (obtain-lock *surflet-table-lock*)
-   (set! *surflet-table* (make-string-table))
-   (release-lock *surflet-table-lock*))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; INSTANCE