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

This commit is contained in:
interp 2003-04-13 18:27:43 +00:00
parent 956fd7bbf1
commit 4b08eac262
1 changed files with 83 additions and 112 deletions

View File

@ -72,19 +72,19 @@
(surflet-request-request s-req) path-string))
((string=? (file-name-extension path-string) ".scm")
(obtain-lock *session-table-lock*)
;; no access to session table until new session-id is saved
(receive (session-id lifetime)
(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
; redirections to origin
(make-session path-string ; used for redirections
(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)
(let ((result (table-ref continuation-table continuation-id)))
(release-lock continuation-table-lock)
result)))))
(with-lock continuation-table-lock
(table-ref continuation-table continuation-id))))))
(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 (generate-new-table-id continuations-table)))
(table-set! continuations-table continuation-id return)
(release-lock continuation-table-lock)
(let ((continuation-id
(with-lock continuation-table-lock
(let ((c-id (generate-new-table-id continuations-table)))
(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*)
(let ((result (table-ref *session-table* session-id)))
(release-lock *session-table-lock*)
result))
(with-lock *session-table-lock*
(table-ref *session-table* session-id)))
;;; 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))
(release-lock *session-table*)))
(set! *session-table* (make-integer-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)))
(release-lock continuation-table-lock)))))
(table-set! continuation-table continuation-id #f))))))))
;;; 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)))
;; only now the lock may be released
(release-lock *surflet-table-lock*)))
surflet-structure))))))
(file-last-mod full-surflet-name))))
surflet-structure))))
(lambda (surflet-name directory)
(let ((full-surflet-name (absolute-file-name surflet-name directory)))
(if (options-cache-surflets?)
(begin
;; 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*)
(with-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
(release-lock *surflet-table-lock*)
(car surflet))
(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))
(release-lock *surflet-table-lock*))
(table-set! *surflet-table* surflet-name #f))))
;;; RESET-SURFLET-CACHE!
;; Clears *SURFLET-TABLE* (locking).
(define (reset-surflet-cache!)
; (with-fatal-handler
; (lambda (condition decline)
; (release-lock *surflet-table-lock*)
; (decline))
(obtain-lock *surflet-table-lock*)
(set! *surflet-table* (make-string-table))
(release-lock *surflet-table-lock*))
(with-lock *surflet-table-lock*
(set! *surflet-table* (make-string-table))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; INSTANCE