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
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))))
(sb-ext:schedule-timer) (catch ',glabel
(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@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
trivial-timeout-devel@common-lisp.net