handle cache reads outside of workers

pull/218/head
Matthew Butterick 5 years ago
parent f725632444
commit 43c981d06c

@ -1 +1 @@
1573509303 1573513757

@ -47,10 +47,21 @@
(define (mod-date-missing-or-changed? source-path template-path) (define (mod-date-missing-or-changed? source-path template-path)
(not (hash-has-key? mod-date-hash (paths->key source-path template-path)))) (not (hash-has-key? mod-date-hash (paths->key source-path template-path))))
(define (parallel-render source-paths job-count-arg) (define (parallel-render source-paths-in job-count-arg)
;; if jobs are already in the cache, pull them out before assigning workers
;; using worker to fetch from cache is slower
(define-values (uncached-source-paths previously-cached-jobs)
(for/fold ([usps null]
[pcjs null])
([path (in-list source-paths-in)])
(match (with-handlers ([(λ (x) (eq? x 'cache-miss)) values])
(render-to-file-if-needed path #f #f (λ () (raise 'cache-miss))))
['cache-miss (values (cons path usps) pcjs)]
[_ (values usps (cons (cons path #true) pcjs))])))
(define job-count (define job-count
(min (min
(length source-paths) (length uncached-source-paths)
(match job-count-arg (match job-count-arg
[#true (processor-count)] [#true (processor-count)]
[(? exact-positive-integer? count) count] [(? exact-positive-integer? count) count]
@ -69,7 +80,9 @@
;; otherwise, a crashed rendering place can't recover, and the parallel job will be stuck. ;; otherwise, a crashed rendering place can't recover, and the parallel job will be stuck.
(with-handlers ([exn:fail? (λ (e) (place-channel-put ch (list 'crashed-job path #f)))]) (with-handlers ([exn:fail? (λ (e) (place-channel-put ch (list 'crashed-job path #f)))])
(match-define-values (_ _ ms _) (match-define-values (_ _ ms _)
(time-apply render-to-file-if-needed (list path))) ;; we don't use `render-to-file-if-needed` because we've already checked the render cache
;; if we reached this point, we know we need a render
(time-apply render-to-file (list path)))
(place-channel-put ch (list 'finished-job path ms)))) (place-channel-put ch (list 'finished-job path ms))))
(loop)))) (loop))))
(handle-evt wp (λ (val) (list* wpidx wp val))))) (handle-evt wp (λ (val) (list* wpidx wp val)))))
@ -77,12 +90,12 @@
(define poly-target (current-poly-target)) (define poly-target (current-poly-target))
;; `locks` and `blocks` are (listof (cons/c evt? path?)) ;; `locks` and `blocks` are (listof (cons/c evt? path?))
(let loop ([source-paths source-paths] (let loop ([source-paths (reverse uncached-source-paths)]
[locks-in null] [locks-in null]
[blocks-in null] [blocks-in null]
;; `completed-jobs` is (listof (cons/c path? boolean?)) ;; `completed-jobs` is (listof (cons/c path? boolean?))
[completed-jobs null] [completed-jobs previously-cached-jobs]
[completed-job-count 0]) [completed-job-count (length previously-cached-jobs)])
;; try to unblock blocked workers ;; try to unblock blocked workers
(define-values (locks blocks) (define-values (locks blocks)
(for/fold ([locks locks-in] (for/fold ([locks locks-in]
@ -94,9 +107,9 @@
(values locks (cons block blocks))] (values locks (cons block blocks))]
[else [else
(place-channel-put wp 'lock-approved) (place-channel-put wp 'lock-approved)
(values (cons block locks) blocks)]))) (values (cons block locks) blocks)])))
(cond (cond
[(eq? completed-job-count (length source-paths)) [(eq? completed-job-count (length source-paths-in))
;; second bite at the apple for crashed jobs. ;; second bite at the apple for crashed jobs.
;; 1) many crashes that arise in parallel rendering are ;; 1) many crashes that arise in parallel rendering are
;; a result of concurrency issues (e.g. shared files not being readable at the right moment). ;; a result of concurrency issues (e.g. shared files not being readable at the right moment).
@ -194,7 +207,8 @@
force? force?
source-path source-path
maybe-output-path maybe-output-path
maybe-template-path) maybe-template-path
maybe-render-thunk)
(unless (file-exists? source-path) (unless (file-exists? source-path)
(raise-user-error caller "~a is not an existing source path" source-path)) (raise-user-error caller "~a is not an existing source path" source-path))
(define output-path (cond (define output-path (cond
@ -214,7 +228,7 @@
[(not render-cache-activated?) 'render-cache-deactivated] [(not render-cache-activated?) 'render-cache-deactivated]
[else #false])) [else #false]))
(when render-needed? (when render-needed?
(define render-thunk (λ () (render source-path template-path output-path))) ; returns either string or bytes (define render-thunk (or maybe-render-thunk (λ () (render source-path template-path output-path)))) ; returns either string or bytes
(define render-result (define render-result
(cond (cond
[render-cache-activated? [render-cache-activated?
@ -236,13 +250,13 @@
#:exists 'replace #:exists 'replace
#:mode (if (string? render-result) 'text 'binary)))) #:mode (if (string? render-result) 'text 'binary))))
(define+provide/contract (render-to-file-if-needed source-path [maybe-template-path #f] [maybe-output-path #f]) (define+provide/contract (render-to-file-if-needed source-path [maybe-template-path #f] [maybe-output-path #f] [maybe-render-thunk #f])
((complete-path?) ((or/c #f complete-path?) (or/c #f complete-path?)) . ->* . void?) ((complete-path?) ((or/c #f complete-path?) (or/c #f complete-path?) (or/c #f procedure?)) . ->* . void?)
(render-to-file-base 'render-to-file-if-needed #f source-path maybe-output-path maybe-template-path)) (render-to-file-base 'render-to-file-if-needed #f source-path maybe-output-path maybe-template-path maybe-render-thunk))
(define+provide/contract (render-to-file source-path [maybe-template-path #f] [maybe-output-path #f]) (define+provide/contract (render-to-file source-path [maybe-template-path #f] [maybe-output-path #f] [maybe-render-thunk #f])
((complete-path?) ((or/c #f complete-path?) (or/c #f complete-path?)) . ->* . void?) ((complete-path?) ((or/c #f complete-path?) (or/c #f complete-path?) (or/c #f procedure?)) . ->* . void?)
(render-to-file-base 'render-to-file #t source-path maybe-output-path maybe-template-path)) (render-to-file-base 'render-to-file #t source-path maybe-output-path maybe-template-path maybe-render-thunk))
(define+provide/contract (render source-path [maybe-template-path #f] [maybe-output-path #f]) (define+provide/contract (render source-path [maybe-template-path #f] [maybe-output-path #f])
((complete-path?) ((or/c #f complete-path?) (or/c #f complete-path?)) . ->* . (or/c string? bytes?)) ((complete-path?) ((or/c #f complete-path?) (or/c #f complete-path?)) . ->* . (or/c string? bytes?))

Loading…
Cancel
Save