[usocket-devel] [drakma-devel] [patch] Resubmit drakma timeout for sbcl.

[Chun Tian (binghe)]

I know SBCL's WITH-TIMEOUT cannot nest, I learn this from GBBopen's portable-threads.lisp [1], and it also give a nested version SBCL's WITH-TIMEOUT, much shorter than yours:

#+sbcl
(defmacro with-timeout ((seconds &body timeout-body) &body timed-body)
  (let ((tag-sym (gensym))
        (timer-sym (gensym)))
    `(block ,tag-sym
       (let ((,timer-sym 
              (sb-ext:make-timer
               #'(lambda () 
                   (return-from ,tag-sym (progn , at timeout-body))))))
         (sb-ext:schedule-timer ,timer-sym ,seconds)
         (unwind-protect (progn , at timed-body)
           (sb-ext:unschedule-timer ,timer-sym))))))

I didn't use this version simply because I think the WITH-TIMEOUT form in usocket's SOCKET-CONNECT has no chance to be nested.

--binghe

在 2011-3-29，04:35， Nikodemus Siivola 写道：

> 2011/3/28 Chun Tian (binghe) <binghe.lisp at gmail.com>:
> 
>> Today I think out another way to solve the SBCL connection timeout issue, I wrap a
>> SB-EXT:WITH-TIMEOUT on SB-BSD-SOCKET:SOCKET-CONNNECT [1], and the result work seems working well:
> 
> That's along the lines I was thinking off, except that
> SB-EXT:WITH-TIMEOUT is a broken construct. (Soon to be deprecated, in
> all likelihood.)
> 
> Consider this:
> 
> (with-timeout 1.0 (handler-case (with-timeout 4.0 (sleep 2))
> (sb-ext:timeout ())))
> 
> which is to say that you cannot distinguish an outer timeout from an
> inner one, which is bad.
> 
> You need something like this, instead:
> 
> (defmacro with-timeout-handler ((seconds timeout-form) &body body)
>  "Runs BODY as an implicit PROGN with timeout of SECONDS. If
> timeout occurs before BODY has finished, BODY is unwound and
> TIMEOUT-FORM is executed with its values returned instead.
> 
> Note that BODY is unwound asynchronously when a timeout occurs,
> so unless all code executed during it -- including anything
> down the call chain -- is asynch unwind safe, bad things will
> happen. Use with care."
>  (alexandria:with-gensyms (exec unwind timer timeout block)
>    `(block ,block
>       (tagbody
>          (flet ((,unwind ()
>                   (go ,timeout))
>                 (,exec ()
>                   , at body))
>            (declare (dynamic-extent #',exec #',unwind))
>            (let ((,timer (sb-ext:make-timer #',unwind)))
>              (declare (dynamic-extent ,timer))
>              (sb-sys:without-interrupts
>                (unwind-protect
>                     (progn
>                       (sb-ext:schedule-timer ,timer ,seconds)
>                       (return-from ,block
>                         (sb-sys:with-local-interrupts
>                           (,exec))))
>                  (sb-ext:unschedule-timer ,timer)))))
>          ,timeout
>          (return-from ,block ,timeout-form)))))
> 
> with which
> 
>  (with-timeout-handler (1.0 :outer) (with-timeout-handler (4.0
> :inner) (sleep 10.0) :ok))
> 
> does the right thing.
> 
> Gods, I hate asynch timeouts. Is there a sane way to tell connect() to
> time out without needing SIGALRM?
> 
> Cheers,
> 
> -- Nikodemus