[rdnzl-devel] Re: rdnzl, multiprocessing, Allegro, windows, locking

[Edi Weitz]

On Fri, 13 Oct 2006 16:58:32 -0700, "Richard Fateman" <fateman at cs.berkeley.edu> wrote:

> Also using  something like this...
>
> ;; prototype for creating a thread
> (defun create-thread(fun)		;function of no arguments, call as
> (create-thread #'thefun)
>   ;; return a .NET thread
>   (new "Thread" (new "ThreadStart" fun)))
>
> (defun start (thethread)		;
>   [Start thethread])
>
> (defun run-thread(fun) ; all together
>   (start (create-thread fun)))
>
> Does not make a difference in the way I wished, of having control
> return to lisp. It still blocks, but worse, it seems that handlers
> are not available for call-backs.

Again, I don't think this is a problem of RDNZL but rather of how the
various Lisp implementations handle callbacks into Lisp.  The
following code works fine (output as expected, no IDE locking) for me
with LispWorks 5.0 and AllegroCL 8.0 (using SLIME) - it crashes with
Corman Lisp 3.0, though.

Cheers,
Edi.



(in-package :rdnzl-user)

;; see <http://www.lispworks.com/documentation/lw50/LWRM/html/lwref-718.htm>
#+:lispworks
(sys:setup-for-alien-threads)

(import-type "System.Threading.Thread")
(import-type "System.Threading.ThreadStart")

(use-namespace "System.Threading")

(enable-rdnzl-syntax)

(defun create-thread (fn)
  (new "Thread" (new "ThreadStart" fn)))

(defun start (thread)
  [Start thread])

(defun run-thread (fn)
  (start (create-thread fn)))

(defparameter *counter* 0)

(defun test (&optional (n 5))
  (let ((out *standard-output*)
        (done nil))
    (flet ((incf-fn ()
             (loop
               (format out "In thread: ~A.~%" (incf *counter*))
               (finish-output out)
               (sleep .3)
               (when done
                 (format out "Thread finishes.~%")
                 (finish-output out)
                 (return-from incf-fn)))))
      (run-thread #'incf-fn)
      (dotimes (i n)
        (format out "Outside: ~A.~%" (incf *counter*))
        (finish-output out)
        (sleep .7))
      (setq done t))))