From bca73fd762372ada0981866f59a9d254345b7c5f Mon Sep 17 00:00:00 2001 From: zane <39070793+zaneenders@users.noreply.github.com> Date: Sun, 29 Sep 2024 13:25:35 -0600 Subject: [PATCH 1/4] Timeline broken. --- src/api/demo.rkt | 1 + src/api/server.rkt | 156 ++++++++++++++++++++++++++++----------------- src/main.rkt | 2 +- 3 files changed, 100 insertions(+), 59 deletions(-) diff --git a/src/api/demo.rkt b/src/api/demo.rkt index 76c0c9f2e..f0c713838 100644 --- a/src/api/demo.rkt +++ b/src/api/demo.rkt @@ -381,6 +381,7 @@ (define (improve req) (improve-common req (λ (command) + (eprintf "HERE\n") (define job-id (start-job command)) (wait-for-job job-id) (redirect-to (add-prefix (format "~a.~a/graph.html" job-id *herbie-commit*)) diff --git a/src/api/server.rkt b/src/api/server.rkt index 52d478f9a..3687eb586 100644 --- a/src/api/server.rkt +++ b/src/api/server.rkt @@ -40,7 +40,7 @@ (define *demo-output* (make-parameter false)) ; verbose logging for debugging -(define verbose #f) ; Maybe change to log-level and use 'verbose? +(define verbose #t) ; Maybe change to log-level and use 'verbose? (define (log msg . args) (when verbose (apply eprintf msg args))) @@ -79,56 +79,90 @@ (rename-file-or-directory tmp-file data-file #t) (copy-file (web-resource "report.html") html-file #t)) +(define single-threaded-jobs (make-hash)) +(define single-threaded-cache (make-hash)) + ; computes the path used for server URLs (define (make-path id) (format "~a.~a" id *herbie-commit*)) ; Returns #f is now job exsist for the given job-id (define (get-results-for job-id) - (define-values (a b) (place-channel)) - (place-channel-put manager (list 'result job-id b)) - (log "Getting result for job: ~a.\n" job-id) - (place-channel-get a)) + (cond + [manager + (define-values (a b) (place-channel)) + (place-channel-put manager (list 'result job-id b)) + (log "Getting result for job: ~a.\n" job-id) + (place-channel-get a)] + [else (hash-ref single-threaded-cache job-id #f)])) (define (get-timeline-for job-id) - (define-values (a b) (place-channel)) - (place-channel-put manager (list 'timeline job-id b)) - (log "Getting timeline for job: ~a.\n" job-id) - (place-channel-get a)) + (cond + [manager + (define-values (a b) (place-channel)) + (place-channel-put manager (list 'timeline job-id b)) + (log "Getting timeline for job: ~a.\n" job-id) + (place-channel-get a)] + [else #f])) ; TODO Not supported yet ; Returns #f if there is no job returns the job-id if there is a completed job. (define (server-check-on job-id) - (define-values (a b) (place-channel)) - (place-channel-put manager (list 'check job-id b)) - (log "Checking on: ~a.\n" job-id) - (place-channel-get a)) + (cond + [manager + (define-values (a b) (place-channel)) + (place-channel-put manager (list 'check job-id b)) + (log "Checking on: ~a.\n" job-id) + (place-channel-get a)] + [else (if (hash-has-key? single-threaded-cache job-id) job-id #f)])) (define (get-improve-table-data) - (define-values (a b) (place-channel)) - (place-channel-put manager (list 'improve b)) - (log "Getting improve results.\n") - (place-channel-get a)) + (cond + [manager + (define-values (a b) (place-channel)) + (place-channel-put manager (list 'improve b)) + (log "Getting improve results.\n") + (place-channel-get a)] + [else #f])) ; TODO Not supported yet (define (job-count) - (define-values (a b) (place-channel)) - (place-channel-put manager (list 'count b)) - (define count (place-channel-get a)) - (log "Current job count: ~a.\n" count) - count) + (cond + [manager + (define-values (a b) (place-channel)) + (place-channel-put manager (list 'count b)) + (define count (place-channel-get a)) + (log "Current job count: ~a.\n" count) + count] + [else (hash-count single-threaded-jobs)])) ;; Starts a job for a given command object| (define (start-job command) (define job-id (compute-job-id command)) - (place-channel-put manager (list 'start manager command job-id)) + (cond + [manager (place-channel-put manager (list 'start manager command job-id))] + [else (hash-set! single-threaded-jobs job-id command)]) (log "Job ~a, Qed up for program: ~a\n" job-id (test-name (herbie-command-test command))) job-id) (define (wait-for-job job-id) - (define-values (a b) (place-channel)) - (place-channel-put manager (list 'wait manager job-id b)) - (define finished-result (place-channel-get a)) - (log "Done waiting for: ~a\n" job-id) - finished-result) + (cond + [manager + (define-values (a b) (place-channel)) + (place-channel-put manager (list 'wait manager job-id b)) + (define finished-result (place-channel-get a)) + (log "Done waiting for: ~a\n" job-id) + finished-result] + [else + (define cached (hash-ref single-threaded-cache job-id #f)) + (cond + [(false? cached) + (log "Waiting for job ~a to finish.\n" job-id) + (define work (hash-ref single-threaded-jobs job-id)) + (hash-remove! single-threaded-jobs job-id) + (define result (herbie-work-on work job-id)) + (log "Done waiting for job ~a to finish.\n" job-id) + (hash-set! single-threaded-cache job-id result) + result] + [else cached])])) ; TODO refactor using this helper. (define (manager-ask msg . args) @@ -138,12 +172,18 @@ (place-channel-get a)) (define (is-server-up) - (not (sync/timeout 0 manager-dead-event))) + (cond + [manager (not (sync/timeout 0 manager-dead-event))] + [else #t])) (define (start-job-server job-cap) - (define r (make-manager job-cap)) - (set! manager-dead-event (place-dead-evt r)) - (set! manager r)) + (eprintf "start-job-server\n") + (cond + [(> job-cap 1) + (define r (make-manager job-cap)) + (set! manager-dead-event (place-dead-evt r)) + (set! manager r)] + [else (set! manager #f)])) (define manager #f) (define manager-dead-event #f) @@ -156,18 +196,6 @@ (define (compute-job-id job-info) (sha1 (open-input-string (~s job-info)))) -(define (wrapper-run-herbie cmd job-id) - (print-job-message (herbie-command-command cmd) job-id (test-name (herbie-command-test cmd))) - (define result - (run-herbie (herbie-command-command cmd) - (herbie-command-test cmd) - #:seed (herbie-command-seed cmd) - #:pcontext (herbie-command-pcontext cmd) - #:profile? (herbie-command-profile? cmd) - #:timeline-disabled? (herbie-command-timeline-disabled? cmd))) - (eprintf "Herbie completed job: ~a\n" job-id) - result) - (define (print-job-message command job-id job-str) (define job-label (match command @@ -334,23 +362,35 @@ (struct work (manager worker-id job-id job)) +(define (herbie-work-on command job-id) + (print-job-message (herbie-command-command command) + job-id + (test-name (herbie-command-test command))) + (define herbie-result + (run-herbie (herbie-command-command command) + (herbie-command-test command) + #:seed (herbie-command-seed command) + #:pcontext (herbie-command-pcontext command) + #:profile? (herbie-command-profile? command) + #:timeline-disabled? (herbie-command-timeline-disabled? command))) + (eprintf "Herbie completed job: ~a\n" job-id) + (match-define (job-result kind test status time _ _ backend) herbie-result) + (match kind + ['alternatives (make-alternatives-result herbie-result test job-id)] + ['evaluate (make-calculate-result herbie-result job-id)] + ['cost (make-cost-result herbie-result job-id)] + ['errors (make-error-result herbie-result job-id)] + ['exacts (make-exacts-result herbie-result job-id)] + ['improve (make-improve-result herbie-result test job-id)] + ['local-error (make-local-error-result herbie-result job-id)] + ['explanations (make-explanation-result herbie-result job-id)] + ['sample (make-sample-result herbie-result test job-id)] + [_ (error 'compute-result "unknown command ~a" kind)])) + (define (run-job job-info) (match-define (work manager worker-id job-id command) job-info) (log "run-job: ~a, ~a\n" worker-id job-id) - (define herbie-result (wrapper-run-herbie command job-id)) - (match-define (job-result kind test status time _ _ backend) herbie-result) - (define out-result - (match kind - ['alternatives (make-alternatives-result herbie-result test job-id)] - ['evaluate (make-calculate-result herbie-result job-id)] - ['cost (make-cost-result herbie-result job-id)] - ['errors (make-error-result herbie-result job-id)] - ['exacts (make-exacts-result herbie-result job-id)] - ['improve (make-improve-result herbie-result test job-id)] - ['local-error (make-local-error-result herbie-result job-id)] - ['explanations (make-explanation-result herbie-result job-id)] - ['sample (make-sample-result herbie-result test job-id)] - [_ (error 'compute-result "unknown command ~a" kind)])) + (define out-result (herbie-work-on command job-id)) (log "Job: ~a finished, returning work to manager\n" job-id) (place-channel-put manager (list 'finished manager worker-id job-id out-result))) diff --git a/src/main.rkt b/src/main.rkt index 8e272913a..51f81d14d 100644 --- a/src/main.rkt +++ b/src/main.rkt @@ -57,7 +57,7 @@ (define demo-port 8000) (define demo-public #f) - (define threads #f) + (define threads 1) (define report-note #f) (define timeout-set? #f) From 3422a3f2c94ff8e6b7c1eca83167e142947aa182 Mon Sep 17 00:00:00 2001 From: zane <39070793+zaneenders@users.noreply.github.com> Date: Sun, 29 Sep 2024 17:12:51 -0600 Subject: [PATCH 2/4] Timeline no longer blocks. --- src/api/server.rkt | 41 +++++++++++++++++++++++++---------------- 1 file changed, 25 insertions(+), 16 deletions(-) diff --git a/src/api/server.rkt b/src/api/server.rkt index 3687eb586..02d96ac66 100644 --- a/src/api/server.rkt +++ b/src/api/server.rkt @@ -103,7 +103,9 @@ (place-channel-put manager (list 'timeline job-id b)) (log "Getting timeline for job: ~a.\n" job-id) (place-channel-get a)] - [else #f])) ; TODO Not supported yet + [else + (define result (hash-ref single-threaded-cache job-id #f)) + (if (false? result) (reverse (unbox (*timeline*))) result)])) ; Returns #f if there is no job returns the job-id if there is a completed job. (define (server-check-on job-id) @@ -138,9 +140,20 @@ (define (start-job command) (define job-id (compute-job-id command)) (cond - [manager (place-channel-put manager (list 'start manager command job-id))] - [else (hash-set! single-threaded-jobs job-id command)]) - (log "Job ~a, Qed up for program: ~a\n" job-id (test-name (herbie-command-test command))) + [manager + (log "Job ~a, Qed up for program: ~a\n" job-id (test-name (herbie-command-test command))) + (place-channel-put manager (list 'start manager command job-id))] + [else + (log "Waiting for job ~a to finish.\n" job-id) + (define job-thread + (thread (λ () + (let loop ([seed #f]) + (match (thread-receive) + [(list work job-id semaphore) (single-thread-herbie work job-id semaphore)]) + (loop seed))))) + (define sema (make-semaphore)) + (thread-send job-thread (list command job-id sema)) + (semaphore-wait sema)]) ;; Block for job to finish job-id) (define (wait-for-job job-id) @@ -151,18 +164,7 @@ (define finished-result (place-channel-get a)) (log "Done waiting for: ~a\n" job-id) finished-result] - [else - (define cached (hash-ref single-threaded-cache job-id #f)) - (cond - [(false? cached) - (log "Waiting for job ~a to finish.\n" job-id) - (define work (hash-ref single-threaded-jobs job-id)) - (hash-remove! single-threaded-jobs job-id) - (define result (herbie-work-on work job-id)) - (log "Done waiting for job ~a to finish.\n" job-id) - (hash-set! single-threaded-cache job-id result) - result] - [else cached])])) + [else (hash-ref single-threaded-cache job-id #f)])) ; TODO refactor using this helper. (define (manager-ask msg . args) @@ -362,6 +364,13 @@ (struct work (manager worker-id job-id job)) +(define (single-thread-herbie command job-id sema) + (eprintf "single-thread-herbie\n") + (define result (herbie-work-on command job-id)) + (log "Done waiting for job ~a to finish.\n" job-id) + (hash-set! single-threaded-cache job-id result) + (semaphore-post sema)) + (define (herbie-work-on command job-id) (print-job-message (herbie-command-command command) job-id From c7e02e91ece1b8aa92a889370ce6840676e3d928 Mon Sep 17 00:00:00 2001 From: zane <39070793+zaneenders@users.noreply.github.com> Date: Sun, 29 Sep 2024 17:15:18 -0600 Subject: [PATCH 3/4] Threaded mode not using place. --- src/api/server.rkt | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/api/server.rkt b/src/api/server.rkt index 02d96ac66..59d19bb52 100644 --- a/src/api/server.rkt +++ b/src/api/server.rkt @@ -124,7 +124,10 @@ (place-channel-put manager (list 'improve b)) (log "Getting improve results.\n") (place-channel-get a)] - [else #f])) ; TODO Not supported yet + [else + (for/list ([(job-id result) (in-hash single-threaded-cache)] + #:when (equal? (hash-ref result 'command) "improve")) + (get-table-data-from-hash result (make-path job-id)))])) (define (job-count) (cond From 12f2b0155203811009738c24f98388064645ec00 Mon Sep 17 00:00:00 2001 From: zane <39070793+zaneenders@users.noreply.github.com> Date: Sun, 29 Sep 2024 17:26:06 -0600 Subject: [PATCH 4/4] Clean up. --- src/api/demo.rkt | 1 - src/api/server.rkt | 13 +++++++------ 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/api/demo.rkt b/src/api/demo.rkt index f0c713838..76c0c9f2e 100644 --- a/src/api/demo.rkt +++ b/src/api/demo.rkt @@ -381,7 +381,6 @@ (define (improve req) (improve-common req (λ (command) - (eprintf "HERE\n") (define job-id (start-job command)) (wait-for-job job-id) (redirect-to (add-prefix (format "~a.~a/graph.html" job-id *herbie-commit*)) diff --git a/src/api/server.rkt b/src/api/server.rkt index 59d19bb52..643f25f0e 100644 --- a/src/api/server.rkt +++ b/src/api/server.rkt @@ -40,7 +40,7 @@ (define *demo-output* (make-parameter false)) ; verbose logging for debugging -(define verbose #t) ; Maybe change to log-level and use 'verbose? +(define verbose #f) ; Maybe change to log-level and use 'verbose? (define (log msg . args) (when verbose (apply eprintf msg args))) @@ -79,7 +79,6 @@ (rename-file-or-directory tmp-file data-file #t) (copy-file (web-resource "report.html") html-file #t)) -(define single-threaded-jobs (make-hash)) (define single-threaded-cache (make-hash)) ; computes the path used for server URLs @@ -137,7 +136,9 @@ (define count (place-channel-get a)) (log "Current job count: ~a.\n" count) count] - [else (hash-count single-threaded-jobs)])) + [else (if job-running 1 0)])) ; We can only have one job running in this mode. + +(define job-running #f) ;; Starts a job for a given command object| (define (start-job command) @@ -155,8 +156,10 @@ [(list work job-id semaphore) (single-thread-herbie work job-id semaphore)]) (loop seed))))) (define sema (make-semaphore)) + (set! job-running #t) (thread-send job-thread (list command job-id sema)) - (semaphore-wait sema)]) ;; Block for job to finish + (semaphore-wait sema) + (set! job-running #f)]) ;; Block for job to finish job-id) (define (wait-for-job job-id) @@ -182,7 +185,6 @@ [else #t])) (define (start-job-server job-cap) - (eprintf "start-job-server\n") (cond [(> job-cap 1) (define r (make-manager job-cap)) @@ -368,7 +370,6 @@ (struct work (manager worker-id job-id job)) (define (single-thread-herbie command job-id sema) - (eprintf "single-thread-herbie\n") (define result (herbie-work-on command job-id)) (log "Done waiting for job ~a to finish.\n" job-id) (hash-set! single-threaded-cache job-id result)