Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Server no place mode #995

Open
wants to merge 4 commits into
base: main
Choose a base branch
from
Open

Server no place mode #995

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
bca73fd
Timeline broken.
zaneenders Sep 29, 2024
3422a3f
Timeline no longer blocks.
zaneenders Sep 29, 2024
c7e02e9
Threaded mode not using place.
zaneenders Sep 29, 2024
12f2b01
Clean up.
zaneenders Sep 29, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
169 changes: 111 additions & 58 deletions src/api/server.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -79,56 +79,98 @@
(rename-file-or-directory tmp-file data-file #t)
(copy-file (web-resource "report.html") html-file #t))

(define single-threaded-cache (make-hash))
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Why does this have to be a separate cache from whatever the manager uses?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Well, I thought it had to be inside the manager for isolation reasons but main seems to work if I make completed-work a global.


; 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
(define result (hash-ref single-threaded-cache job-id #f))
(if (false? result) (reverse (unbox (*timeline*))) result)]))
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

(if result result (reverse ...)) or just (and result (reverse ...)

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Also is this correct? If there is a result it looks like it'll save it.

Also wait why goes into single-threaded-cache? In fact, how can we ever call this method while the timeline is running? Why not just always return #f?


; 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
(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)
(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 (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)
(define job-id (compute-job-id command))
(place-channel-put manager (list 'start manager command job-id))
(log "Job ~a, Qed up for program: ~a\n" job-id (test-name (herbie-command-test command)))
(cond
[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)
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Wrong long message?

(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))
(set! job-running #t)
(thread-send job-thread (list command job-id sema))
(semaphore-wait sema)
(set! job-running #f)]) ;; Block for job to finish
Comment on lines +152 to +162
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Why put this in a thread? Won't this thread keep running forever? Don't we only send it one job? Why have a thread at all?

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Also if there was no thread you wouldn't need a semaphor. And if you did that you wouldn't need the single-thread-herbie function which does very little on its own.

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 (hash-ref single-threaded-cache job-id #f)]))
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I don't think this ever returns #f in multi-threaded-mode? Maybe just make it crash in single-threaded mode if you wait for a job you didn't start. (Also maybe in multi-threaded mode?)


; TODO refactor using this helper.
(define (manager-ask msg . args)
Expand All @@ -138,12 +180,17 @@
(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))
(cond
[(> job-cap 1)
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think single-threaded mode should be separate from the concept of 1 thread. Maybe just make it a separate method or a global parameter or something?

(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)
Expand All @@ -156,18 +203,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
Expand Down Expand Up @@ -334,23 +369,41 @@

(struct work (manager worker-id job-id job))

(define (single-thread-herbie command job-id sema)
(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
(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)))

Expand Down
2 changes: 1 addition & 1 deletion src/main.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -57,7 +57,7 @@
(define demo-port 8000)
(define demo-public #f)

(define threads #f)
(define threads 1)
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Again I think #f for no threads and 1 for one thread should be separate (because even in "1 thread" mode you in fact spawn a number of places, even though only one of them is a worker thread.)

(define report-note #f)
(define timeout-set? #f)

Expand Down