check existence of sessions in some locking areas
This commit is contained in:
parent
64371c9941
commit
87a4165f94
|
@ -316,9 +316,11 @@
|
||||||
;; surveillance of killing new session that has the same number by
|
;; surveillance of killing new session that has the same number by
|
||||||
;; accident)
|
;; accident)
|
||||||
(let ((session (table-ref *session-table* session-id)))
|
(let ((session (table-ref *session-table* session-id)))
|
||||||
(memo-killed! (session-memo session)))
|
(if session
|
||||||
;; why can't table entries be deleted correctly?
|
(begin
|
||||||
(table-set! *session-table* session-id #f)
|
(memo-killed! (session-memo session))
|
||||||
|
(table-set! *session-table* session-id #f))))
|
||||||
|
;; else: somebody was faster than we
|
||||||
(release-lock *session-table-lock*))
|
(release-lock *session-table-lock*))
|
||||||
|
|
||||||
;;; SESSION-ADJUST-TIMEOUT!
|
;;; SESSION-ADJUST-TIMEOUT!
|
||||||
|
@ -330,17 +332,21 @@
|
||||||
|
|
||||||
(define (really-session-adjust-timeout! session-id time-to-live)
|
(define (really-session-adjust-timeout! session-id time-to-live)
|
||||||
(obtain-lock *session-table-lock*)
|
(obtain-lock *session-table-lock*)
|
||||||
(let* ((session (table-ref *session-table* session-id))
|
(let ((session (table-ref *session-table* session-id))
|
||||||
(memo (session-memo session))
|
|
||||||
(new-memo (make-default-memo)))
|
(new-memo (make-default-memo)))
|
||||||
|
(if session
|
||||||
|
(let ((memo (session-memo session)))
|
||||||
;; Do it this way: new values and then new message
|
;; Do it this way: new values and then new message
|
||||||
(set-memo:value memo
|
(set-memo:value memo
|
||||||
(+ (time) time-to-live))
|
(+ (time) time-to-live))
|
||||||
(set-memo:new-memo memo new-memo)
|
(set-memo:new-memo memo new-memo)
|
||||||
;; I don't think we need locking here. Do you agree?
|
;; I don't think we need locking here. Do you agree?
|
||||||
(set-session-memo! session new-memo)
|
(set-session-memo! session new-memo)
|
||||||
(set-memo:message memo 'adjust-timeout))
|
(set-memo:message memo 'adjust-timeout)
|
||||||
(release-lock *session-table-lock*))
|
(release-lock *session-table-lock*))
|
||||||
|
(begin
|
||||||
|
(release-lock *session-table-lock*)
|
||||||
|
(error "There is no session with this ID" session-id)))))
|
||||||
|
|
||||||
;;; ADJUST-TIMEOUT!
|
;;; ADJUST-TIMEOUT!
|
||||||
;; Resets time-to-die of current session. The argument must be
|
;; Resets time-to-die of current session. The argument must be
|
||||||
|
@ -522,13 +528,13 @@
|
||||||
;;; RESET-SURFLET-CACHE!
|
;;; RESET-SURFLET-CACHE!
|
||||||
;; Clears *SURFLET-TABLE* (locking).
|
;; Clears *SURFLET-TABLE* (locking).
|
||||||
(define (reset-surflet-cache!)
|
(define (reset-surflet-cache!)
|
||||||
(with-fatal-handler
|
; (with-fatal-handler
|
||||||
(lambda (condition decline)
|
; (lambda (condition decline)
|
||||||
(release-lock *surflet-table-lock*)
|
; (release-lock *surflet-table-lock*)
|
||||||
(decline))
|
; (decline))
|
||||||
(obtain-lock *surflet-table-lock*)
|
(obtain-lock *surflet-table-lock*)
|
||||||
(set! *surflet-table* (make-string-table))
|
(set! *surflet-table* (make-string-table))
|
||||||
(release-lock *surflet-table-lock*)))
|
(release-lock *surflet-table-lock*))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;;; INSTANCE
|
;;; INSTANCE
|
||||||
|
|
Loading…
Reference in New Issue