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
	
	 interp
						interp