Compile patterns outside the cache lock
ober
e50e203cfff4468c1b36c30c5e68e0780b763e5a
--- a/src/jerboa-pcre2/pcre2.ss +++ b/src/jerboa-pcre2/pcre2.ss @@ -323,24 +323,37 @@ (def *cache-lock* (make-mutex)) (def (pcre2-compile/cached pattern) - (call-with-mutex *cache-lock* - (lambda () - (let ([entry (assoc pattern *cache*)]) - (if (and entry (pcre-regex-live? (cdr entry))) - (begin - ;; Move to front while still holding the cache guard. - (set! *cache* (cons entry (remq entry *cache*))) - (cdr entry)) - (begin - (when entry - (set! *cache* (remq entry *cache*))) - ;; Compile under the cache guard so two misses cannot publish - ;; duplicate entries or race the fixed-size LRU bound. - (let ([rx (pcre2-compile pattern)]) - (set! *cache* (cons (cons pattern rx) *cache*)) - (when (> (length *cache*) *cache-max*) - (set! *cache* (list-head *cache* *cache-max*))) - rx))))))) + ;; Fast path: a live hit is returned and moved to front under the guard. + (let ([hit (call-with-mutex *cache-lock* + (lambda () + (let ([entry (assoc pattern *cache*)]) + (and entry (pcre-regex-live? (cdr entry)) + (begin + (set! *cache* (cons entry (remq entry *cache*))) + (cdr entry))))))]) + (if hit + hit + ;; Slow path: compile WITHOUT holding the cache lock so one slow or + ;; hostile compile cannot block every other cache user. The insert + ;; still happens under the guard; a concurrent insert of the same + ;; pattern wins and the duplicate compile is released. The fixed-size + ;; LRU bound is only ever mutated under the guard. + (let ([rx (pcre2-compile pattern)]) + (call-with-mutex *cache-lock* + (lambda () + (let ([entry (assoc pattern *cache*)]) + (if (and entry (pcre-regex-live? (cdr entry))) + (begin + (release-regex-native! rx) + (set! *cache* (cons entry (remq entry *cache*))) + (cdr entry)) + (begin + (when entry + (set! *cache* (remq entry *cache*))) + (set! *cache* (cons (cons pattern rx) *cache*)) + (when (> (length *cache*) *cache-max*) + (set! *cache* (list-head *cache* *cache-max*))) + rx))))))))) (def (remove-from-cache! regex) (call-with-mutex *cache-lock*