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.

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))

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

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

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

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

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

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))))))))

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)