original commit: d034b3a72827725928870e1abb4f3cb88e46d9e9
This commit is contained in:
Matthew Flatt 2004-05-12 00:49:40 +00:00
parent c08f5fadb9
commit 60b9849aa3

View File

@ -169,12 +169,11 @@
;; breaks disabled re-tokenize should be called when lock is not ;; breaks disabled re-tokenize should be called when lock is not
;; held. When it exits, the lock will be held. ;; held. When it exits, the lock will be held.
(define/private (re-tokenize in in-start-pos) (define/private (re-tokenize in in-start-pos)
(let-values (((lexeme type data new-token-start new-token-end) (get-token in))) (let-values ([(lexeme type data new-token-start new-token-end)
;; breaks must be disabled before the semaphore wait so we can't be ;; Allow breaks while getting tokens
;; broken out of the critical section (parameterize-break #t
(break-enabled #f) (get-token in))])
;; If a break occurs while we are suspended, the break will occur ;; Also allow breaks while trying to enter the critical region:
;; and the critical section will not be entered
(semaphore-wait/enable-break mutex-lock) (semaphore-wait/enable-break mutex-lock)
(unless (eq? 'eof type) (unless (eq? 'eof type)
(let ((len (- new-token-end new-token-start))) (let ((len (- new-token-end new-token-start)))
@ -202,7 +201,6 @@
(set! invalid-tokens-start +inf.0)) (set! invalid-tokens-start +inf.0))
(else (else
(semaphore-post mutex-lock) (semaphore-post mutex-lock)
(break-enabled #t)
(re-tokenize in in-start-pos))))))) (re-tokenize in in-start-pos)))))))
(define/private (do-insert/delete edit-start-pos change-length) (define/private (do-insert/delete edit-start-pos change-length)
@ -274,22 +272,15 @@
(let/ec restart (let/ec restart
(parameterize ((current-exception-handler (parameterize ((current-exception-handler
(lambda (exn) (lambda (exn)
;; Lock is not held here because breaks are disabled
;; whenever lock is held
(break-enabled #f)
(restart)))) (restart))))
(break-enabled #t)
(with-handlers ((exn:fail? (with-handlers ((exn:fail?
(lambda (exn) (lambda (exn)
(parameterize ((print-struct #t)) (parameterize ((print-struct #t))
(printf "colorer thread: ~s\n" exn)) (printf "colorer thread: ~s\n" exn))
(break-enabled #f)
(semaphore-wait mutex-lock)))) (semaphore-wait mutex-lock))))
(re-tokenize (open-input-text-editor this current-pos end-pos (re-tokenize (open-input-text-editor this current-pos end-pos
(lambda (x) (values #f 1))) (lambda (x) (values #f 1)))
current-pos)) current-pos))
;; Breaks should be disabled from exit of re-tokenize
;; lock will be held
(set! up-to-date? #t) (set! up-to-date? #t)
(semaphore-post mutex-lock) (semaphore-post mutex-lock)
(thread-suspend (current-thread)))) (thread-suspend (current-thread))))
@ -313,10 +304,10 @@
(set! pairs pairs-) (set! pairs pairs-)
(set! parens (new paren-tree% (matches pairs))) (set! parens (new paren-tree% (matches pairs)))
(unless background-thread (unless background-thread
(break-enabled #f) ;; Create background thread with breaks initially disabled:
(parameterize-break #f
(set! background-thread (set! background-thread
(thread (lambda () (background-colorer-entry)))) (thread (lambda () (background-colorer-entry))))))
(break-enabled #t))
(do-insert/delete start-pos 0))) (do-insert/delete start-pos 0)))
;; See docs ;; See docs