concurrency repairs
This commit is contained in:
parent
9bbe4e5095
commit
3a99e9e82c
|
@ -208,7 +208,7 @@
|
||||||
((done #t) #f #f)))
|
((done #t) #f #f)))
|
||||||
init-val (list* 'single 'vertical-label style))]
|
init-val (list* 'single 'vertical-label style))]
|
||||||
[p (make-object horizontal-pane% f)])
|
[p (make-object horizontal-pane% f)])
|
||||||
(send p set-alignment 'right 'center)
|
(send p set-alignment 'right 'center)
|
||||||
(send f stretchable-height #f)
|
(send f stretchable-height #f)
|
||||||
(ok-cancel
|
(ok-cancel
|
||||||
(lambda () (make-object button% "OK" p (done #t) '(border)))
|
(lambda () (make-object button% "OK" p (done #t) '(border)))
|
||||||
|
|
|
@ -28,7 +28,7 @@
|
||||||
(let ([s (atomically
|
(let ([s (atomically
|
||||||
(let ([s (or close-sema (make-semaphore))])
|
(let ([s (or close-sema (make-semaphore))])
|
||||||
(unless close-sema (set! close-sema s))
|
(unless close-sema (set! close-sema s))
|
||||||
s))])
|
(semaphore-peek-evt s)))])
|
||||||
(super show on?)
|
(super show on?)
|
||||||
(yield s)
|
(yield s)
|
||||||
(void))
|
(void))
|
||||||
|
|
|
@ -355,7 +355,7 @@
|
||||||
(when v (handle-event v))
|
(when v (handle-event v))
|
||||||
(yield evt))))]
|
(yield evt))))]
|
||||||
[else
|
[else
|
||||||
(sync e)]))]))
|
(sync evt)]))]))
|
||||||
|
|
||||||
(define event-dispatch-handler (make-parameter void))
|
(define event-dispatch-handler (make-parameter void))
|
||||||
(define (main-eventspace? e)
|
(define (main-eventspace? e)
|
||||||
|
|
|
@ -3,6 +3,7 @@
|
||||||
ffi/unsafe
|
ffi/unsafe
|
||||||
"../../syntax.rkt"
|
"../../syntax.rkt"
|
||||||
"../common/queue.rkt"
|
"../common/queue.rkt"
|
||||||
|
"../../lock.rkt"
|
||||||
"types.rkt"
|
"types.rkt"
|
||||||
"utils.rkt"
|
"utils.rkt"
|
||||||
"frame.rkt")
|
"frame.rkt")
|
||||||
|
@ -51,9 +52,10 @@
|
||||||
(unless on?
|
(unless on?
|
||||||
(set! dialog-level 0))
|
(set! dialog-level 0))
|
||||||
(unless on?
|
(unless on?
|
||||||
(when close-sema
|
(atomically
|
||||||
(semaphore-post close-sema)
|
(when close-sema
|
||||||
(set! close-sema #f)))
|
(semaphore-post close-sema)
|
||||||
|
(set! close-sema #f))))
|
||||||
(super direct-show on?))
|
(super direct-show on?))
|
||||||
|
|
||||||
(define/override (center dir wrt)
|
(define/override (center dir wrt)
|
||||||
|
@ -66,9 +68,11 @@
|
||||||
|
|
||||||
(define/override (show on?)
|
(define/override (show on?)
|
||||||
(if on?
|
(if on?
|
||||||
(unless close-sema
|
(let ([s (atomically
|
||||||
(let ([s (make-semaphore)])
|
(let ([s (or close-sema (make-semaphore))])
|
||||||
(set! close-sema s)
|
(unless close-sema (set! close-sema s))
|
||||||
(super show on?)
|
(semaphore-peek-evt s)))])
|
||||||
(yield s)))
|
(super show on?)
|
||||||
|
(yield s)
|
||||||
|
(void))
|
||||||
(super show on?))))
|
(super show on?))))
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
#lang scheme/base
|
#lang scheme/base
|
||||||
|
|
||||||
(require mred/private/syntax
|
(require mred/private/syntax
|
||||||
|
mred/private/lock
|
||||||
scheme/math
|
scheme/math
|
||||||
scheme/class
|
scheme/class
|
||||||
"hold.ss"
|
"hold.ss"
|
||||||
|
@ -143,11 +144,15 @@
|
||||||
(define default-dc-backend%
|
(define default-dc-backend%
|
||||||
(class* object% (dc-backend<%>)
|
(class* object% (dc-backend<%>)
|
||||||
|
|
||||||
(define lock (make-semaphore 1))
|
;; Using the global lock here is troublesome, becase
|
||||||
|
;; operations involving paths, regions, and text can
|
||||||
|
;; take arbitrarily long. Parts of the editor infrastructure,
|
||||||
|
;; meanwhile, assume that the global lock can be taken
|
||||||
|
;; around actions that use the editor-canvas dc. If we
|
||||||
|
;; have a separate per-dc lock, we can hit deadlock due to
|
||||||
|
;; lock order.
|
||||||
(define/public (call-with-cr-lock thunk)
|
(define/public (call-with-cr-lock thunk)
|
||||||
(call-with-semaphore
|
(as-entry thunk))
|
||||||
lock
|
|
||||||
thunk))
|
|
||||||
|
|
||||||
(define/public (get-cr) #f)
|
(define/public (get-cr) #f)
|
||||||
(define/public (release-cr cr) (void))
|
(define/public (release-cr cr) (void))
|
||||||
|
@ -964,7 +969,7 @@
|
||||||
(if (= i (string-length s))
|
(if (= i (string-length s))
|
||||||
(values w h d a)
|
(values w h d a)
|
||||||
(let ([ch (string-ref s i)])
|
(let ([ch (string-ref s i)])
|
||||||
(let ([v (hash-ref size-cache (vector id sz ch) #f)])
|
(let ([v (atomically (hash-ref size-cache (vector id sz ch) #f))])
|
||||||
(if v
|
(if v
|
||||||
(loop (add1 i)
|
(loop (add1 i)
|
||||||
(+ w (vector-ref v 0))
|
(+ w (vector-ref v 0))
|
||||||
|
@ -1073,9 +1078,10 @@
|
||||||
(let ([id (send font get-font-id)]
|
(let ([id (send font get-font-id)]
|
||||||
[sz (send font get-point-size)])
|
[sz (send font get-point-size)])
|
||||||
(lambda (ch w h d a)
|
(lambda (ch w h d a)
|
||||||
(hash-set! size-cache
|
(atomically
|
||||||
(vector id sz ch)
|
(hash-set! size-cache
|
||||||
(vector w h d a)))))])
|
(vector id sz ch)
|
||||||
|
(vector w h d a))))))])
|
||||||
(begin0
|
(begin0
|
||||||
(for/fold ([w 0.0][h 0.0][d 0.0][a 0.0])
|
(for/fold ([w 0.0][h 0.0][d 0.0][a 0.0])
|
||||||
([ch (in-string s)])
|
([ch (in-string s)])
|
||||||
|
|
|
@ -41,6 +41,8 @@
|
||||||
|
|
||||||
(require openssl/mzssl)
|
(require openssl/mzssl)
|
||||||
|
|
||||||
|
(require (only racket/base log-error))
|
||||||
|
|
||||||
;; Constant for messages without a title:
|
;; Constant for messages without a title:
|
||||||
(define no-subject-string "<No subject>")
|
(define no-subject-string "<No subject>")
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user