[trivial-timeout-devel] SBCL: throw to nonexistent tag

[Gary King]

Hi Thanks for the patch. I'll add a test case and try to get this out  
this weekend.


On Nov 7, 2008, at 7:08 PM, dat wrote:

> With sbcl 1.0.21, the SBCL timer object seems to still exists after  
> code execution completes if the time for execution of the code body  
> is small. This results in throw being called to a catch tag which  
> has vanished into the mists if execution time of the body is short...
>
> * (trivial-timeout:with-timeout (3) (foofoo))
> ...
> "foofoo"
> NIL
> *
> [after a few seconds...]
>
> debugger invoked on a SB-INT:SIMPLE-CONTROL-ERROR:
>  attempt to THROW to a tag that does not exist: #:|label-617|
>
>
> Keeping track of the timer object and unscheduling it seems to take  
> care of things. A corresponding patch:
>
> --- trivial-timeout/dev/with-timeout.lisp    2008-11-07  
> 15:59:19.000000000 -0800
> +++ trivial-timeout-dat/dev/with-timeout.lisp    2008-11-07  
> 15:59:45.000000000 -0800
> @@ -43,17 +43,22 @@
> (defun generate-platform-specific-code (seconds-symbol doit-symbol)
>   (let ((glabel (gensym "label-"))
>     (gused-timer? (gensym "used-timer-")))
> -    `(let ((,gused-timer? nil))
> +    `(let* ((,gused-timer? nil)
> +        (gtimer
> +         (sb-ext:make-timer (lambda ()
> +                  (setf ,gused-timer? t)
> +                  (throw ',glabel nil))))
> +        )
>        (catch ',glabel
>      (sb-ext:schedule-timer
> -      (sb-ext:make-timer (lambda ()
> -                   (setf ,gused-timer? t)
> -                   (throw ',glabel nil)))
> +      gtimer
>       ,seconds-symbol)
> -     (,doit-symbol))
> +     (,doit-symbol)
> +     (sb-ext:unschedule-timer gtimer)) ; nice cleanup for SBCL
>        (when ,gused-timer?
>      (error 'timeout-error)))))
>
> +
> #+(and sbcl sb-thread)
> (defun generate-platform-specific-code (seconds-symbol doit-symbol)
>   `(handler-case
>
>
>
>
> _______________________________________________
> trivial-timeout-devel mailing list
> trivial-timeout-devel at common-lisp.net
> http://common-lisp.net/cgi-bin/mailman/listinfo/trivial-timeout-devel

--
Gary Warren King, metabang.com
Cell: (413) 559 8738
Fax: (206) 338-4052
gwkkwg on Skype * garethsan on AIM