Is there a clever way using bordeaux threads to do the following. given a thunk and a timeout (in seconds or ms etc) , I want to start evaluating the thunk but if it takes more time than the timeout, I want to kill it. Then I'd like to return some sort of data structure indicating the function's return value and the amount of time it took, or that the timeout was reached and the thread was killed. I thought about starting thread 1 which calls a (sleep time-out) then kills thread 2 then and start thread 2 which evaluates the thunk, and kills thread 1 then in the parent thread call join on both 1 and 2 But there is a race condition if both finish and try to kill the other also I'm not sure how to start 2 threads where each one knows about the other. also the bordeaux thread docs don't indicate what join-thread does if the thread had already been killed as opposed to finished successfully. Maybe there's an idiom for this. Can someone help? Thanks.
![]() |
0 |
![]() |
Here is what I came up with. It seems to work, but I'm pretty sure there's a race condition because I had to insert the (when th2 ....) which doesn't seem necessary to me. Any advise would be appreciate. (defun call-with-timeout (time-out thunk) (let (th1 th2 result) (setf th2 (bordeaux-threads:make-thread (lambda () (sleep time-out) (bordeaux-threads:destroy-thread th1) (setf result (list :time-out time-out))))) (setf th1 (bordeaux-threads:make-thread (lambda () (let* ((t1 (get-internal-run-time)) (s2 (funcall thunk)) (t2 (get-internal-run-time))) (when th2 (bordeaux-threads:destroy-thread th2)) (setf result (list :time (/ (- t2 t1) internal-time-units-per-second) :value s2)))))) (ignore-errors (bordeaux-threads:join-thread th1)) (ignore-errors (bordeaux-threads:join-thread th2)) result))
![]() |
0 |
![]() |
On 12/22/16 11:16 AM, Jim Newton wrote: > Is there a clever way using bordeaux threads to do the following. > > given a thunk and a timeout (in seconds or ms etc) , I want to start evaluating the thunk > but if it takes more time than the timeout, I want to kill it. > Then I'd like to return some sort of data structure indicating the function's return value > and the amount of time it took, or that the timeout was reached and the thread was killed. > > I thought about starting thread 1 which calls a (sleep time-out) then kills thread 2 then > and start thread 2 which evaluates the thunk, and kills thread 1 > then in the parent thread call join on both 1 and 2 Why do you have to kill thread 1? Can't you just catch a thread-already-dead error and let it terminate normally? paul
![]() |
0 |
![]() |
On Thursday, December 22, 2016 at 6:36:12 PM UTC+1, paul wallich wrote: > Why do you have to kill thread 1? Can't you just catch a > thread-already-dead error and let it terminate normally? > > paul Hi Paul, It seems to me that I have to kill thread 1 because otherwise it will take up cpu time from the next time I call call-with-timeout. Right? If thread 1 takes longer than time-out number of seconds, I need to kill it. Maybe I don't understand your idea. Please explain further. Jim
![]() |
0 |
![]() |
On 12/23/16 3:59 AM, Jim Newton wrote: > On Thursday, December 22, 2016 at 6:36:12 PM UTC+1, paul wallich wrote: >> Why do you have to kill thread 1? Can't you just catch a >> thread-already-dead error and let it terminate normally? >> >> paul > > Hi Paul, It seems to me that I have to kill thread 1 because otherwise it will take up cpu time from the next time I call call-with-timeout. Right? If thread 1 takes longer than time-out number of seconds, I need to kill it. > > Maybe I don't understand your idea. Please explain further. I may well be the one who doesn't understand -- I was assuming that thread 1 could terminate itself when it was done. So in that case your cost is (at most) the CPU time for thread 1 from when thread 2 returns until the timeout. And you save the resource utilization (in both CPU/memory footprint and programmer headscratching) that it would otherwise cost to avoid the race condition. But I could well be mistaken. paul
![]() |
0 |
![]() |
On Thu, 22 Dec 2016 09:04:44 -0800 (PST), Jim Newton <jimka.issy@gmail.com> wrote: >Here is what I came up with. >It seems to work, but I'm pretty sure there's a race condition because >I had to insert the (when th2 ....) which doesn't seem necessary to me. >Any advise would be appreciate. > > >(defun call-with-timeout (time-out thunk) > (let (th1 th2 result) > (setf th2 (bordeaux-threads:make-thread > (lambda () > (sleep time-out) > (bordeaux-threads:destroy-thread th1) > (setf result (list :time-out time-out))))) > (setf th1 (bordeaux-threads:make-thread > (lambda () > (let* ((t1 (get-internal-run-time)) > (s2 (funcall thunk)) > (t2 (get-internal-run-time))) > (when th2 > (bordeaux-threads:destroy-thread th2)) > (setf result > (list :time (/ (- t2 t1) internal-time-units-per-second) > :value s2)))))) > (ignore-errors (bordeaux-threads:join-thread th1)) > (ignore-errors (bordeaux-threads:join-thread th2)) > result)) Bordeaux supports timeouts on many platforms. Is this just an exercise? If you don't have timeouts ... hmm ... There always will be a race condition with 2 children because Bordeaux doesn't have a portable multiple event wait. I would have the parent wait on a lock which is released by the children as their last operation(s). When the parent wakes up, it kills both children unconditionally and proceeds based on whether the compute thread's result is valid. If the time thread finishes first, the result still *may* be valid depending on thread scheduling - the compute thread may run again before the parent and have an opportunity to finish. So you need to check the result in any case. Something like: *UNTESTED* (defun call-with-timeout (time-out thunk) (let* ( (lock (make-lock)) (result nil) (t-comp (make-thread (lambda () : (setf result ...) (release-lock lock) ))) (t-time (make-thread (lambda () (sleep time-out) (release-lock lock) ))) ) (aquire-lock lock) (aquire-lock lock) ;; 2nd aquire blocks parent (destroy-thread t-comp) (join-thread t-comp) (destroy-thread t-time) (join-thread t-time) result )) There's an analogous solution using condition variables, but in Bordeaux locks are simpler. Hope this helps, George
![]() |
0 |
![]() |
On Sat, 24 Dec 2016 03:44:42 -0500, George Neuner <gneuner2@comcast.net> wrote: >(defun call-with-timeout (time-out thunk) > (let* > ( > (lock (make-lock)) > (result nil) > (t-comp (make-thread > (lambda () > : > (setf result ...) > (release-lock lock) > ))) > (t-time (make-thread > (lambda () > (sleep time-out) > (release-lock lock) > ))) > ) > (aquire-lock lock) > (aquire-lock lock) ;; 2nd aquire blocks parent > > (destroy-thread t-comp) > (join-thread t-comp) > (destroy-thread t-time) > (join-thread t-time) > > result > )) In case it isn't apparent, there is a race condition in this code also. The children have to run long enough to let the parent aquire the lock. You can't entirely remove the race condition, but you can minimize it by using additional locks (or a condition) to block the children from starting until the parent is ready. It would be easier if Bordeaux had events. George
![]() |
0 |
![]() |
What you're asking for is the entire purpose of condition variables. I wrote a timer-wheel utility to provide clock ticks...anyway, I have a simple example of condition variables there. https://github.com/npatrick04/timer-wheel/blob/master/examples/simple.lisp I adapted the simple example to meet your requirements. It seems a bit verbose for what you want, but gets the job done. CL-USER> (main 0.5) (TIMEOUT NIL) CL-USER> (main 2) (42 1) Example: (asdf:load-system :timer-wheel) (defparameter the-result 'not-computed) (defparameter cv (bt:make-condition-variable)) (defparameter lock (bt:make-lock)) (defun calc-result () (let ((result (progn (sleep 1) 42))) (bt:with-lock-held (lock) (if (eq the-result 'not-computed) (progn (setf the-result result) (bt:condition-notify cv)) (error "The main thread should be killing me!"))))) (defun timeout-handler (wheel timer) (declare (ignore wheel timer)) (bt:with-lock-held (lock) (setf the-result 'timeout) (bt:condition-notify cv))) (defun main (timeout) ;; Reset the result for recomputing things (setf the-result 'not-computed) (let* ((wheel (tw:make-wheel)) (count 0) (timer (tw:make-timer #'timeout-handler)) (counter (tw:make-timer (lambda (whl tmr) (incf count) (tw:schedule-timer whl tmr :ticks 1))))) ;; Start processing, and then shutdown gracefully (tw:with-timer-wheel wheel (tw:schedule-timer wheel timer :seconds timeout) (tw:schedule-timer wheel counter :ticks 1) (let ((worker (bt:make-thread #'calc-result :name "Calculating Thread"))) (bt:with-lock-held (lock) (bt:condition-wait cv lock) (if (eq the-result 'timeout) (progn (bt:destroy-thread worker) (list the-result nil)) (list the-result ;; Default resolution of the timer wheel is 100ms (* count 1/10))))))))
![]() |
0 |
![]() |
I cleaned up my code a bit here. https://github.com/npatrick04/timer-wheel/blob/master/examples/execute-timeout.lisp ;; CL-USER> (timer-wheel.examples:execute-timeout (lambda () (sleep 1) 42) 2) ;; (42 1) ;; CL-USER> (timer-wheel.examples:execute-timeout (lambda () (sleep 1) 42) 0.5) ;; (TIMER-WHEEL.EXAMPLES::TIMEOUT NIL)
![]() |
0 |
![]() |