[Openmcl-devel] Timers...

[Jon S. Anthony]

Hi,

I'm porting a system to CCL and one bit I've come up to is a with-timer
capability.  Is something like this pretty much the "right" way to
achieve this in CCL?  I know about Dan Corkill's variant (in
"portable-threads"), but this seems a bit better.  Yes?  No?


#+ccl
(defun interrupt-timer (interruptable-process semaphore duration func)
  (let ((work-done (ccl:timed-wait-on-semaphore semaphore duration)))
    (when (not work-done)
      (ccl:process-interrupt
       interruptable-process
       func))))

#+ccl
(defmacro with-timer ((seconds-available &body timeout-forms) &body
body)
  (with-gensyms (semaphore tag)
    `(let* ((,semaphore (ccl:make-semaphore))
            (,tag (gensym)))
       (ccl:process-run-function
        "timer-proc"
        #'interrupt-timer
        ccl:*current-process*
        ,semaphore ,seconds-available
        #'(lambda () (throw ,tag (progn , at timeout-forms))))
       (catch ,tag
         (unwind-protect
            (progn , at body)
           (ccl:signal-semaphore ,semaphore))) )))