Goodies...

Anyway… after all the esoteric delving into Reppy Channels, Apple-like Dispatch-queues, and Butterfly, here’s the PAR construct reduced to its minimum for LW:

;; -------------------------------------------
;; PAR Construct

(defun %par (fn &rest fns)
  (let* ((nfns (length fns))
         (sem  (mp:make-semaphore :count 0)))
    (dolist (fn fns)
      (mp:funcall-async (lambda ()
                          (unwind-protect
                              (funcall fn)
                            (mp:semaphore-release sem)))
                        ))
    (prog1
        (funcall fn)
      (mp:semaphore-acquire sem :count nfns))))
  
(defmacro par1 (&rest clauses)
  ;; like PROG1, but executes all clauses in parallel, synchronizing
  ;; at the closing paren, and returning value of first clause
  (when clauses
    (if (rest clauses)
        `(%par ,@(mapcar #`(lambda ()
                             ,a1)
                         clauses))
      ;; else
      (first clauses))))

(defmacro par (&rest clauses)
  ;; like PROGN, but executes all clauses in parallel, synchronizing
  ;; at the closing paren, and returning value of last clause
  `(par1 ,@(nreverse clauses)))

———————

I use this all the time in signal processing when I have to send multiple channels through filter banks and perform FFT’s on multi-channel signals. Using a PAR construct allows me to write the individual channel clauses and have them all operating in parallel on an SMP machine, like most of us have now. It really speeds things up and keeps the CPU humming.

Cheers,

- DM

_______________________________________________
Lisp Hug - the mailing list for LispWorks users
lisp-hug@lispworks.com
http://www.lispworks.com/support/lisp-hug.html

Re: Goodies...

… not to beat a dead horse, but here is an improved version…

;; -------------------------------------------
;; PAR Construct

(defmethod group ((lst list) n)
  (unless (plusp n)
    (error "zero or negative length"))
  (labels ((rec (source acc)
             (let ((rest (nthcdr n source)))
               (if (consp rest)
                   (rec rest (cons (subseq source 0 n) acc))
                 (nreverse (cons source acc))))))
    (when lst
      (rec lst nil))))
 
(defun %par1 (&rest fns)
  ;; Accept a list of functions, execute them all in parallel and
  ;; return the value of the first one.
  ;;
  ;; Since they are all slated for parallel execution, evaluation
  ;; order must be irrelevant.
  ;;
  ;; We group them to try to balance the load among available threads,
  ;; including our own. Since our thread is doing all the work, try to
  ;; keep the shortest subgroup for our thread.
  ;;
  (let* ((nfns  (length fns))
         (sem   (mp:make-semaphore :count 0))
         ;; count our thread plus available BG threads
         (nthr  (1+ (mp:set-funcall-async-limit nil)))
         (ngrp  (ceiling nfns nthr))
         (grps  (nreverse (group (rest fns) ngrp)))
         (count 0))
    (dolist (grp (rest grps)) ;; last (now first) group will be shorter if any are
      (dolist (fn grp)
        (incf count)
        (mp:funcall-async (lambda ()
                            (unwind-protect
                                (funcall fn)
                              (mp:semaphore-release sem)))
                          )))
    (prog1
        (progn
          (dolist (fn (first grps))
            (funcall fn))
          (funcall (first fns)))
      (mp:semaphore-acquire sem :count count)
      )))
  
(defmacro par1 (&rest clauses)
  ;; like PROG1, but executes all clauses in parallel, synchronizing
  ;; at the closing paren, and returning value of first clause
  (when clauses
    (if (rest clauses)
        `(%par1 ,@(mapcar #`(lambda ()
                             ,a1)
                         clauses))
      ;; else
      (first clauses))))

(defmacro par (&rest clauses)
  ;; like PROGN, but executes all clauses in parallel, synchronizing
  ;; at the closing paren, and returning value of last clause
  `(par1 ,@(nreverse clauses)))

#|
  ;; NOTE: if you execute this from the editor, the editor will use
  ;; one BG thread for itself.  And so the results will be off,
  ;; compared to executing this from the listener or some other non-BG
  ;; thread.
  ;;
  ;; Since we had up to 5 BG threads, this ought to take 3 seconds for
  ;; 18 clauses.  Adding just one more clause copy will push us to 4
  ;; seconds.
(time
 (par
   (sleep 1) ;; 1
   (sleep 1) ;; 2
   (sleep 1) ;; 3
   (sleep 1) ;; 4
   (sleep 1) ;; 5
   
   (sleep 1) ;; 1
   (sleep 1) ;; 2
   (sleep 1) ;; 3
   (sleep 1) ;; 4
   (sleep 1) ;; 5

   (sleep 1) ;; 1
   (sleep 1) ;; 2
   (sleep 1) ;; 3
   (sleep 1) ;; 4
   (sleep 1) ;; 5
   
   (sleep 1) ;; 1
   (sleep 1) ;; 2
   (sleep 1) ;; 3
   ))
 |#


_______________________________________________
Lisp Hug - the mailing list for LispWorks users
lisp-hug@lispworks.com
http://www.lispworks.com/support/lisp-hug.html

Re: Goodies...

Hi David,

Thanks for sharing this!
Does this program require a specific dependency?


Cam



> On 7 Feb 2017, at 16:17, David McClain <dbm@refined-audiometrics.com> wrote:
> 
> … not to beat a dead horse, but here is an improved version…
> 
> ;; -------------------------------------------
> ;; PAR Construct
> 
> (defmethod group ((lst list) n)
>  (unless (plusp n)
>    (error "zero or negative length"))
>  (labels ((rec (source acc)
>             (let ((rest (nthcdr n source)))
>               (if (consp rest)
>                   (rec rest (cons (subseq source 0 n) acc))
>                 (nreverse (cons source acc))))))
>    (when lst
>      (rec lst nil))))
> 
> (defun %par1 (&rest fns)
>  ;; Accept a list of functions, execute them all in parallel and
>  ;; return the value of the first one.
>  ;;
>  ;; Since they are all slated for parallel execution, evaluation
>  ;; order must be irrelevant.
>  ;;
>  ;; We group them to try to balance the load among available threads,
>  ;; including our own. Since our thread is doing all the work, try to
>  ;; keep the shortest subgroup for our thread.
>  ;;
>  (let* ((nfns  (length fns))
>         (sem   (mp:make-semaphore :count 0))
>         ;; count our thread plus available BG threads
>         (nthr  (1+ (mp:set-funcall-async-limit nil)))
>         (ngrp  (ceiling nfns nthr))
>         (grps  (nreverse (group (rest fns) ngrp)))
>         (count 0))
>    (dolist (grp (rest grps)) ;; last (now first) group will be shorter if any are
>      (dolist (fn grp)
>        (incf count)
>        (mp:funcall-async (lambda ()
>                            (unwind-protect
>                                (funcall fn)
>                              (mp:semaphore-release sem)))
>                          )))
>    (prog1
>        (progn
>          (dolist (fn (first grps))
>            (funcall fn))
>          (funcall (first fns)))
>      (mp:semaphore-acquire sem :count count)
>      )))
> 
> (defmacro par1 (&rest clauses)
>  ;; like PROG1, but executes all clauses in parallel, synchronizing
>  ;; at the closing paren, and returning value of first clause
>  (when clauses
>    (if (rest clauses)
>        `(%par1 ,@(mapcar #`(lambda ()
>                             ,a1)
>                         clauses))
>      ;; else
>      (first clauses))))
> 
> (defmacro par (&rest clauses)
>  ;; like PROGN, but executes all clauses in parallel, synchronizing
>  ;; at the closing paren, and returning value of last clause
>  `(par1 ,@(nreverse clauses)))
> 
> #|
>  ;; NOTE: if you execute this from the editor, the editor will use
>  ;; one BG thread for itself.  And so the results will be off,
>  ;; compared to executing this from the listener or some other non-BG
>  ;; thread.
>  ;;
>  ;; Since we had up to 5 BG threads, this ought to take 3 seconds for
>  ;; 18 clauses.  Adding just one more clause copy will push us to 4
>  ;; seconds.
> (time
> (par
>   (sleep 1) ;; 1
>   (sleep 1) ;; 2
>   (sleep 1) ;; 3
>   (sleep 1) ;; 4
>   (sleep 1) ;; 5
> 
>   (sleep 1) ;; 1
>   (sleep 1) ;; 2
>   (sleep 1) ;; 3
>   (sleep 1) ;; 4
>   (sleep 1) ;; 5
> 
>   (sleep 1) ;; 1
>   (sleep 1) ;; 2
>   (sleep 1) ;; 3
>   (sleep 1) ;; 4
>   (sleep 1) ;; 5
> 
>   (sleep 1) ;; 1
>   (sleep 1) ;; 2
>   (sleep 1) ;; 3
>   ))
> |#
> 
> 
> _______________________________________________
> Lisp Hug - the mailing list for LispWorks users
> lisp-hug@lispworks.com
> http://www.lispworks.com/support/lisp-hug.html


_______________________________________________
Lisp Hug - the mailing list for LispWorks users
lisp-hug@lispworks.com
http://www.lispworks.com/support/lisp-hug.html