mbutterick
/
pollen
3
3
Fork 0
Code Issues 1 Pull Requests Projects Releases Wiki Activity

recover from crashed parallel renders

Browse Source
pull/218/head
Matthew Butterick 5 years ago
parent bc9694ae05
commit bc86b3632d
2 changed files with 59 additions and 39 deletions
Show Stats Download Patch File Download Diff File

2
pollen/private/ts.rktd
Unescape Escape View File

@ -1 +1 @@
1572991771 1572993457

96
pollen/render.rkt
Unescape Escape View File

@ -84,50 +84,70 @@
(place-channel-put/get ch (list 'wants-job))) (place-channel-put/get ch (list 'wants-job)))
(parameterize ([current-poly-target poly-target]) (parameterize ([current-poly-target poly-target])
(place-channel-put/get ch (list 'wants-lock (->output-path path))) (place-channel-put/get ch (list 'wants-lock (->output-path path)))
(match-define-values (_ _ ms _) (with-handlers ([exn:fail? (λ (e) (place-channel-put ch (list 'crashed-job path #f)))])
(time-apply render-from-source-or-output-path (list path))) (match-define-values (_ _ ms _)
(place-channel-put ch (list 'finished-job path ms))) (time-apply render-from-source-or-output-path (list path)))
(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)))))
(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 (sort source-paths string<? #:key path->string)][locks-in null][blocks-in null]) (define crashed-jobs
;; try to unblock blocked workers (let loop ([source-paths (sort source-paths string<? #:key path->string)]
(define-values (locks blocks) [locks-in null]
(for/fold ([locks locks-in] [blocks-in null]
[blocks null]) [crashed-jobs null])
([block (in-list blocks-in)]) ;; try to unblock blocked workers
(match-define (cons wp path) block) (define-values (locks blocks)
(cond (for/fold ([locks locks-in]
[(member path (dict-values locks)) [blocks null])
(values locks (cons block blocks))] ([block (in-list blocks-in)])
[else (match-define (cons wp path) block)
(place-channel-put wp 'lock-approved) (cond
(values (cons block locks) blocks)]))) [(member path (dict-values locks))
;; no source paths means all jobs have been assigned (values locks (cons block blocks))]
;; no locks means no jobs are in progress [else
;; therefore we must be done. (place-channel-put wp 'lock-approved)
(unless (and (null? source-paths) (null? locks)) (values (cons block locks) blocks)])))
(match (apply sync worker-evts) ;; no source paths means all jobs have been assigned
[(list wpidx wp 'wants-job) ;; no locks means no jobs are in progress
(match source-paths ;; therefore we must be done.
[(? null?) (loop null locks blocks)] (cond
[(cons path rest) [(and (null? source-paths) (null? locks)) crashed-jobs]
(place-channel-put wp (cons path poly-target)) [else
(loop rest locks blocks)])] (match (apply sync worker-evts)
[(list wpidx wp 'finished-job path ms) [(list wpidx wp 'wants-job)
(message (match source-paths
(format "rendered parallel @ job ~a /~a ~a" [(? null?) (loop null locks blocks crashed-jobs)]
(add1 wpidx) [(cons path rest)
(find-relative-path (current-project-root) (->output-path path)) (place-channel-put wp (cons path poly-target))
(if (< ms 1000) (format "(~a ms)" ms) (format "(~a s)" (/ ms 1000.0))))) (loop rest locks blocks crashed-jobs)])]
(loop source-paths (match (assoc wp locks) [(list wpidx wp (and (or 'finished-job 'crashed-job) tag) path ms)
[#false locks] (match tag
[lock (remove lock locks)]) blocks)] ['finished-job
[(list wpidx wp 'wants-lock path) (message
(loop source-paths locks (append blocks (list (cons wp path))))])))] (format "rendered parallel @ job ~a /~a ~a"
(add1 wpidx)
(find-relative-path (current-project-root) (->output-path path))
(if (< ms 1000) (format "(~a ms)" ms) (format "(~a s)" (/ ms 1000.0)))))]
[_
(message
(format "render crash @ job ~a /~a (retry pending)"
(add1 wpidx)
(find-relative-path (current-project-root) (->output-path path))))])
(loop source-paths
(match (assoc wp locks)
[#false locks]
[lock (remove lock locks)])
blocks
(match tag
['crashed-job (cons path crashed-jobs)]
[_ crashed-jobs]))]
[(list wpidx wp 'wants-lock path)
(loop source-paths locks (append blocks (list (cons wp path))) crashed-jobs)])])))
(for-each render-from-source-or-output-path crashed-jobs)]
[else (for-each render-from-source-or-output-path paths-in)])) [else (for-each render-from-source-or-output-path paths-in)]))
(define (pagetree->paths pagetree-or-path) (define (pagetree->paths pagetree-or-path)

Write Preview
Loading…
Cancel
Save