From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: X-Original-To: caml-list@yquem.inria.fr Delivered-To: caml-list@yquem.inria.fr Received: from mail1-relais-roc.national.inria.fr (mail1-relais-roc.national.inria.fr [192.134.164.82]) by yquem.inria.fr (Postfix) with ESMTP id 8F0B9BBAF for ; Thu, 15 Jul 2010 20:37:31 +0200 (CEST) X-IronPort-Anti-Spam-Filtered: true X-IronPort-Anti-Spam-Result: AlkDAHfxPkzRVllBlGdsb2JhbACBQ4RPjG+MaxUBAQEBCQsICREDH784AoJ1gi0Eg34 X-IronPort-AV: E=Sophos;i="4.55,209,1278280800"; d="scan'208,217";a="63862410" Received: from elasmtp-kukur.atl.sa.earthlink.net ([209.86.89.65]) by mail1-smtp-roc.national.inria.fr with ESMTP; 15 Jul 2010 20:37:30 +0200 Received: from [69.254.201.214] (helo=[10.0.1.6]) by elasmtp-kukur.atl.sa.earthlink.net with esmtpa (Exim 4.67) (envelope-from ) id 1OZTJI-0004Cr-RB for caml-list@yquem.inria.fr; Thu, 15 Jul 2010 14:37:29 -0400 Mime-Version: 1.0 (Apple Message framework v753.1) In-Reply-To: <87zkxsfvsg.fsf@frosties.localdomain> References: <87sk3mcaeq.fsf@frosties.localdomain> <87zkxsfvsg.fsf@frosties.localdomain> Content-Type: multipart/alternative; boundary=Apple-Mail-8-264137949 Message-Id: From: David McClain Subject: Re: [Caml-list] Smart ways to implement worker threads Date: Thu, 15 Jul 2010 11:37:28 -0700 To: caml-list@yquem.inria.fr X-Mailer: Apple Mail (2.753.1) X-ELNK-Trace: 7a0ab3eafc8cf994b22988ad1c62733440683398e744b8a4f246482fc8fbd948d35a172962002535667c3043c0873f7e350badd9bab72f9c350badd9bab72f9c X-Originating-IP: 69.254.201.214 X-Spam: no; 0.00; lear:01 ocaml:01 ocaml:01 ocaml's:01 reppy:01 translated:01 implements:01 reppy:01 requestor:01 requestor:01 nesting:01 combinators:01 accessor:01 accessor:01 lambda:01 --Apple-Mail-8-264137949 Content-Transfer-Encoding: quoted-printable Content-Type: text/plain; charset=ISO-8859-1; delsp=yes; format=flowed > It is too bad I don't want to lear CML but use Ocaml. The CML examples > from the book don't translate into ocaml since the interface is just a > little bit different and those differences are what throws me off. I That may appear to be the case from only a cursory review of CML. But =20= I find that OCaml's notions of Events, Channels, etc, correspond =20 quite closely to what John Reppy describes. The whole point of Reppy's work was to show how "Events" could be =20 made into functional objects, with operations for combination among =20 them. I don't have the "sort" routine translated, but here is some Lisp =20 code that attempts to provide the multiple-readers / single-writer =20 locks as might be used in a database application. It demonstrates the =20= use of wrap, sync, etc... ----------------------------------- ;; rwgate.lisp -- Multiple Reader/Single Writer using Reppy's Channels ;; ;; DM/MCFA 01/00 ;; ---------------------------------------------------- (defpackage "RWGATE" (:use "USEFUL-MACROS" "COMMON-LISP" "REPPY-CHANNELS" "SPM" =20 "LISPWORKS") (:export "MAKE-LOCK" "WRAP-RDLOCKEVT" "WRAP-WRLOCKEVT" "WITH-READLOCK" "WITH-WRITELOCK")) (in-package "RWGATE") ;; --------------------------------------------------------------- ;; This package implements a multiple-reader/single-writer lock ;; protocol using the amazing capabilities of the Reppy channels. ;; ;; Rule of engagement: ;; ;; 1. A lock is available for reading if no write locks are in place, ;; or else the read lock requestor is equal to the write lock holder. ;; ;; 2. A lock is available for writing if no read locks and no write =20 locks ;; are in place, ;; or else the write lock requestor is equal to the write lock =20 holder, ;; or else the write lock requestor is equal to every read lock =20 holder. ;; ;; These rules ensure that multiple readers can run, while only one ;; writer can run. No requirements for nesting of read/write lock ;; requests. That is, a writer can request a read lock and vice versa, ;; and issue lock releases in any order. ;; ;; A lock holder can request any number of additional locks. The lock =20= will ;; actually be released when an equal number of releases of like kind ;; have been obtained. For every write lock there is a write release, ;; and for every read lock there is a read release. ;; ;; The Reppy protocol is protected with UNWIND-PROTECT to ensure that ;; locks held are released on exit from the function block being =20 executed ;; within the province of a lock. Lock releases are handled =20 transparently ;; to the user. ;; ;; --------------------------------------------------------------- ;; Lock server protocol with event combinators (defclass rw-lock () ((rdlocks :accessor rw-lock-rdlocks :initform 0) (wrlocks :accessor rw-lock-wrlocks :initform 0) (wrowner :accessor rw-lock-wrowner :initform nil) (rdqueue :accessor rw-lock-rdqueue :initform nil) (rdowners :accessor rw-lock-rdowners :initform nil) (wrqueue :accessor rw-lock-wrqueue :initform nil))) (defun make-lock () (make-instance 'rw-lock :handlers (list :read #'(lambda (req gate who) (declare (ignore req)) (labels ((take-it () (incf (rw-lock-rdlocks gate)) (push who (rw-lock-rdowners gate)) (spawn #'send who t))) (cond ((eq who (rw-lock-wrowner gate)) ;; we own a write lock already so go ahead... (take-it)) =09 ((plusp (rw-lock-wrlocks gate)) ;; outstanding write lock so enqueue in ;; pending readers queue... (push who (rw-lock-rdqueue gate))) =09 (t ;; no outstanding writer so take it... (take-it)) ))) =09 :release-read #'(lambda (req gate who) (declare (ignore req)) (removef (rw-lock-rdowners gate) who :count 1) (if (and (zerop (decf (rw-lock-rdlocks gate))) (zerop (rw-lock-wrlocks gate))) ;; no more readers and no more writers ;; (a writer might have been me...) ;; so go ahead and start writers ;; there should be no pending readers ;; since there were no writers (let ((writer (pop (rw-lock-wrqueue gate)))) (when writer (incf (rw-lock-wrlocks gate)) (setf (rw-lock-wrowner gate) writer) (spawn #'send writer t)) ))) =09 :write #'(lambda (req gate who) (declare (ignore req)) (labels ((take-it () (incf (rw-lock-wrlocks gate)) (setf (rw-lock-wrowner gate) who) (spawn #'send who t))) (cond ((and (zerop (rw-lock-rdlocks gate)) (zerop (rw-lock-wrlocks gate))) ;; gate available so take it (take-it)) =09 ((eq who (rw-lock-wrowner gate)) ;; gate already owned by requestor ;; so incr lock count and tell him its = okay... (take-it)) =09 ((every #'(lambda (rdr) (eq rdr who)) (rw-lock-rdowners gate)) ;; only one reader and it is me... ;; but I may be in the list numerous =20 times... ;; so go ahead and grab a write lock. (take-it)) =09 (t ;; gate not available -- put caller on ;; waiting writers queue (conc1f (rw-lock-wrqueue gate) who)) ))) =09 :release-write #'(lambda (req gate who) (declare (ignore req who)) (labels ((run-writer () (let ((writer (pop (rw-lock-wrqueue gate)))) (if writer (progn (incf (rw-lock-wrlocks gate)) (setf (rw-lock-wrowner gate) writer) (spawn #'send writer t) t) nil))) (run-readers () (let ((readers (rw-lock-rdqueue gate))) (if readers (progn (setf (rw-lock-rdqueue gate) nil) (appendf (rw-lock-rdowners gate) = readers) (incf (rw-lock-rdlocks gate) =20 (length readers)) (dolist (reader readers) (spawn #'send reader t)) t) nil)))) (when (zerop (decf (rw-lock-wrlocks gate))) ;; no more writers (was only me anyway...) (setf (rw-lock-wrowner gate) nil) (if (zerop (rw-lock-rdlocks gate)) ;; if no active readers either ;; then it is a toss up whether to ;; start writers or readers (if (zerop (random 2)) ;; add some = non-determinism (unless (run-writer) (run-readers)) (unless (run-readers) (run-writer))) ;; but if I was a reader too, ;; then it is only safe to start other ;; readers. (run-readers))) )) ))) (defun wrap-lockEvt (lock fn args req rel) (guard #'(lambda () (let ((replyCh (make-channel))) (labels ((acquire-lock () (service-request req lock replyCh)) (release-lock () (service-request rel lock replyCh))) (spawn #'acquire-lock) (wrap-abort (wrap (recvEvt replyCh) #'(lambda (reply) (declare (ignore reply)) (unwind-protect (apply fn args) (spawn #'release-lock)))) #'(lambda () (spawn #'(lambda () (recv replyCh) (release-lock))))) ))) )) (defmethod wrap-rdLockEvt ((lock rw-lock) fn &rest args) (wrap-lockEvt lock fn args :read :release-read)) (defmethod wrap-wrLockEvt ((lock rw-lock) fn &rest args) (wrap-lockEvt lock fn args :write :release-write)) (defmethod with-readlock ((lock rw-lock) fn &rest args) (sync (apply #'wrap-rdLockEvt lock fn args))) (defmethod with-writelock ((lock rw-lock) fn &rest args) (sync (apply #'wrap-wrLockEvt lock fn args))) ----------------------------------- Dr. David McClain Chief Technical Officer Refined Audiometrics Laboratory 4391 N. Camino Ferreo Tucson, AZ 85750 email: dbm@refined-audiometrics.com phone: 1.520.390.3995 web: http://refined-audiometrics.com On Jul 15, 2010, at 11:24, Goswin von Brederlow wrote: > Rich Neswold writes: > >> On Wed, Jul 14, 2010 at 11:09 AM, Goswin von Brederlow > b@web.de> >> wrote: >> >> 4) Do some magic with Event.t? >> >> Problem: never used this and I could use a small example how =20 >> to use >> this. >> >> >> Event.t (and its associated library) *is* magical in that it =20 >> provides an >> absolutely beautiful concurrent programming model. Forget about =20 >> select() and >> mutexes and other ugly threading concepts. Event.t and friends is =20 >> how it should >> be done. >> >> John H. Reppy's "Concurrent Programming in ML" provides a thorough >> understanding of how to use this module effectively. This book =20 >> presents the >> material in a very understandable way:=C2 deficiencies=C2 in current =20= >> threading >> models are discussed as well as how CML solves the limitations and =20= >> constraints. >> The book can be purchased or downloaded free online. > > It is too bad I don't want to lear CML but use Ocaml. The CML examples > from the book don't translate into ocaml since the interface is just a > little bit different and those differences are what throws me off. I > figue spawn becomes Thread.cread and I have to add Event.sync or > Event.select and Event.wrap at some points. At which point the book > becomes useless to understanding how Ocamls Event module is to be used > I'm afraid. Also doesn't tell me what Ocamls limitations and =20 > constraints > are. > > So if you have used this in ocaml could you give a short example? > E.g. the merge sort from the book. > > MfG > Goswin > > _______________________________________________ > Caml-list mailing list. Subscription management: > http://yquem.inria.fr/cgi-bin/mailman/listinfo/caml-list > Archives: http://caml.inria.fr > Beginner's list: http://groups.yahoo.com/group/ocaml_beginners > Bug reports: http://caml.inria.fr/bin/caml-bugs > --Apple-Mail-8-264137949 Content-Transfer-Encoding: quoted-printable Content-Type: text/html; charset=ISO-8859-1
It is too bad I don't want = to lear CML but use Ocaml. The CML examples
from = the book don't translate into ocaml since the interface is just = a
little bit different and those differences are = what throws me off. I
That may appear to be the case = from only a cursory review of CML. But I find that OCaml's notions of = Events, Channels, etc, correspond quite closely to what John Reppy = describes. 

The whole point of Reppy's work was to show how = "Events" could be made into functional objects, with operations for = combination among them.
I don't have the "sort" routine = translated, but here is some Lisp code that attempts to provide the = multiple-readers / single-writer locks as might be used in a database = application. It demonstrates the use of wrap, sync, etc...

  (:use "USEFUL-MACROS" = "COMMON-LISP" "REPPY-CHANNELS" "SPM" = "LISPWORKS")
  (:export = "MAKE-LOCK"
           = "WRAP-RDLOCKEVT"
           = "WRAP-WRLOCKEVT"
           = "WITH-READLOCK"
           = "WITH-WRITELOCK"))

(in-package = "RWGATE")

;; = ---------------------------------------------------------------
= ;; This package implements a multiple-reader/single-writer = lock
;; protocol using the amazing capabilities of the Reppy = channels.
;;
;; Rule of = engagement:
;;
;; 1. A lock is available for reading = if no write locks are in place,
;;    or else the = read lock requestor is equal to the write lock = holder.
;;
;; 2. A lock is available for writing if = no read locks and no write locks
;;    are in = place,
;;    or else the write lock requestor is = equal to the write lock holder,
;;    or else the = write lock requestor is equal to every read lock = holder.
;;
;; These rules ensure that multiple = readers can run, while only one
;; writer can run. No = requirements for nesting of read/write lock
;; requests. That = is, a writer can request a read lock and vice versa,
;; and = issue lock releases in any order.
;;
;; A lock = holder can request any number of additional locks. The lock = will
;; actually be released when an equal number of releases = of like kind
;; have been obtained. For every write lock there = is a write release,
;; and for every read lock there is a read = release.
;;
;; The Reppy protocol is protected with = UNWIND-PROTECT to ensure that
;; locks held are released on = exit from the function block being executed
;; within the = province of a lock. Lock releases are handled transparently
;; = to the user.
;;
;; = ---------------------------------------------------------------
= ;; Lock server protocol with event = combinators

(defclass rw-lock = (<serviceable-protocol-mixin>)
  ((rdlocks = :accessor  rw-lock-rdlocks  :initform = 0)
   (wrlocks :accessor  rw-lock-wrlocks =  :initform 0)
   (wrowner :accessor =  rw-lock-wrowner  :initform nil)
   = (rdqueue :accessor  rw-lock-rdqueue  :initform = nil)
   (rdowners :accessor rw-lock-rdowners = :initform nil)
   (wrqueue :accessor =  rw-lock-wrqueue  :initform = nil)))

(defun make-lock = ()
  (make-instance
   = 'rw-lock
   :handlers (list
   =            
     =          :read
     =          #'(lambda (req gate = who)
               =    (declare (ignore req))
=  (labels ((take-it ()
    = (incf (rw-lock-rdlocks gate))
    = (push who (rw-lock-rdowners gate))
=     (spawn #'send who t)))
=    (cond ((eq who (rw-lock-wrowner gate))
=   ;; we own a write lock already so go = ahead...
  = (take-it))
=  
=  ((plusp (rw-lock-wrlocks = gate))
=   ;; outstanding write lock so = enqueue in 
  ;; = pending readers queue...
  (push who = (rw-lock-rdqueue gate)))
=  
=  (t
=   ;; no outstanding writer so take it...
=   (take-it))
=  )))
    =  
             =  :release-read
           =    #'(lambda (req gate who)
     =              (declare (ignore = req))
=  (removef (rw-lock-rdowners gate) who :count = 1)
               =    (if (and (zerop (decf (rw-lock-rdlocks = gate)))
               =             (zerop (rw-lock-wrlocks = gate)))
     ;; = no more readers and no more writers
=      ;; (a writer might have been me...)
=      ;; so go ahead and start writers
=      ;; there should be no pending = readers
     ;; = since there were no writers
         =              (let ((writer (pop = (rw-lock-wrqueue gate))))
         =                (when = writer
               =            (incf (rw-lock-wrlocks = gate))
               =            (setf (rw-lock-wrowner gate) = writer)
               =            (spawn #'send writer = t))
               =          )))
  =    
             =  :write
             =  #'(lambda (req gate who)
       =            (declare (ignore = req))
=  (labels ((take-it ()
=     (incf (rw-lock-wrlocks gate))
=     (setf (rw-lock-wrowner gate) who)
=     (spawn #'send who t)))
=    (cond ((and (zerop (rw-lock-rdlocks gate))
= (zerop (rw-lock-wrlocks gate)))
=   ;; gate available so take it
=   (take-it))
=  
=  ((eq who (rw-lock-wrowner = gate))
=   ;; gate already owned by = requestor
  ;; so = incr lock count and tell him its okay...
=   (take-it))
=  
=  ((every #'(lambda = (rdr)
=      (eq rdr = who))
=  (rw-lock-rdowners = gate))
=   ;; only one reader and it is = me...
               =             ;; but I may be in the list = numerous times...
  ;; so go = ahead and grab a write lock.
  = (take-it))
=  
=  (t 
=   ;; gate not available -- put caller on
=   ;; waiting writers queue
=   (conc1f (rw-lock-wrqueue gate) who))
=  )))
    =  
             =  :release-write
           =    #'(lambda (req gate who)
     =              (declare (ignore req = who))
               =    (labels
           =            ((run-writer = ()
               =           (let ((writer (pop (rw-lock-wrqueue = gate))))
             =               (if = writer
               =                 = (progn
= (incf (rw-lock-wrlocks = gate))
= (setf (rw-lock-wrowner gate) = writer)
               =                   (spawn = #'send writer t)
           =                     =   t)
    = nil)))
               =         (run-readers ()
   =                     =   (let ((readers (rw-lock-rdqueue gate)))
   =                     =     (if readers
         =                     =   (progn
             =                     = (setf (rw-lock-rdqueue gate) nil)
(appendf = (rw-lock-rdowners gate) readers)
       =                     =       (incf (rw-lock-rdlocks gate) (length = readers))
             =                     = (dolist (reader readers)
         =                     =       (spawn #'send reader t))
   =                     =           t)
     =                     =     nil))))
           =          (when (zerop (decf (rw-lock-wrlocks = gate)))
     ;; = no more writers (was only me anyway...)
     =                  (setf = (rw-lock-wrowner gate) nil)
     (if = (zerop (rw-lock-rdlocks gate))
 ;; if no = active readers either
 ;; then it = is a toss up whether to
 ;; start = writers or readers
 (if (zerop = (random 2)) ;; add some non-determinism
=      (unless (run-writer)
= (run-readers))
  =  (unless (run-readers)
    =  (run-writer)))
;; but if I was a = reader too,
;; then it is = only safe to start other
;; = readers.
= (run-readers)))
  =  ))
             =  )))

(defun wrap-lockEvt (lock fn args req = rel)
  (guard
   #'(lambda = ()
       (let ((replyCh = (make-channel)))
         = (labels
             = ((acquire-lock ()
           =      (service-request req lock = replyCh))
             =  (release-lock ()
         =        (service-request rel lock = replyCh)))
           (spawn = #'acquire-lock)
           = (wrap-abort
           =  (wrap (recvEvt replyCh)
       =            #'(lambda = (reply)
               =        (declare (ignore = reply))
               =        (unwind-protect
     =                     =  (apply fn args)
           =              (spawn = #'release-lock))))
           =  #'(lambda ()
           =      (spawn #'(lambda ()
     =                     =   (recv replyCh)
           =                 = (release-lock)))))
           = )))
   ))

(defmethod = wrap-rdLockEvt ((lock rw-lock) fn &rest = args)
  (wrap-lockEvt lock fn args :read = :release-read))

(defmethod wrap-wrLockEvt = ((lock rw-lock) fn &rest args)
  (wrap-lockEvt = lock fn args :write :release-write))

(defmethod = with-readlock ((lock rw-lock) fn &rest = args)
  (sync (apply #'wrap-rdLockEvt lock fn = args)))

(defmethod with-writelock ((lock = rw-lock) fn &rest args)
  (sync (apply = #'wrap-wrLockEvt lock fn args)))
Dr. David McClain
Chief = Technical Officer
Refined Audiometrics = Laboratory
4391 N. Camino Ferreo
Tucson, AZ  85750


=

On Jul 15, 2010, at 11:24, Goswin von Brederlow = wrote:


=
On Wed, Jul 14, 2010 at = 11:09 AM, Goswin von Brederlow <goswin-v-b@web.de>

    = 4) Do some magic with Event.t?

    Problem: never used = this and I could use a small example how to use
    = this.


Event.t = (and its associated library) *is* magical in that it provides = an
absolutely beautiful concurrent programming = model. Forget about select() and
mutexes and = other ugly threading concepts. Event.t and friends is how it = should
be done.

John H. = Reppy's "Concurrent Programming in ML" provides a thorough
understanding of how to use this module effectively. = This book presents the
material in a very = understandable way:=C2 deficiencies=C2 in current = threading
models are discussed as well as = how CML solves the limitations and constraints.
The book can be purchased or downloaded free = online.
It is too bad I don't want to = lear CML but use Ocaml. The CML examples
from the = book don't translate into ocaml since the interface is just a
little bit different and those differences are what = throws me off. I
figue spawn becomes Thread.cread = and I have to add Event.sync or
Event.select = and Event.wrap at some points. At which point the book
becomes useless to understanding how Ocamls Event = module is to be used
I'm afraid. Also doesn't = tell me what Ocamls limitations and constraints
are.

So if you have used this in = ocaml could you give a short example?
E.g. the = merge sort from the book.

MfG
        = Goswin

Caml-list mailing list. Subscription = management:

=

= --Apple-Mail-8-264137949--