;;; Eager-beaver and ;;; an example of multiprocessing in ACL version 6 ;;; by Stuart C. Shapiro ;;; September 2, 2002 (defmacro eband (&rest args) "Evaluates its arguments in parallel, in separate processes. Returns True if all its arguments evaluate to True. Returns nil if, and as soon as, any of its arguments evaluate to nil." ;; Written by Stuart C. Shapiro (let ((flag (gensym)) ; to get final answer (childProcessCount (gensym)) ; number of child processes (childProcessCountSemaphore (gensym)) (localresult (gensym))) ; local to each child process `(let ((,flag t) (,childProcessCount ,(length args)) (,childProcessCountSemaphore (mp:make-process-lock :name "childProcessCountSemaphore"))) ,@(mapcar ;; Spawn a child process for each argument. #'(lambda (arg) `(mp:process-run-function (list :name (format nil "Child for ~A" ',arg) :resume-hook ;; Evaluated whenever process is resumed. #'(lambda () (when (null ,flag) ;; As soon as flag is set to nil, ;; decrement count and quit. (mp:with-process-lock (,childProcessCountSemaphore) (decf ,childProcessCount)) (format t "~&Killing ~A~%" mp:*current-process*) (mp:process-kill mp:*current-process*)))) ;; Function run by each child process. #'(lambda () (format t "~&Processing ~A" ',arg) (let ((,localresult ,arg)) ; Here's what takes time. ;; Contribute the value of its arg ;; to the final value. (unless ,localresult (setf ,flag nil)) ;; When finish, check out. (mp:with-process-lock (,childProcessCountSemaphore) (decf ,childProcessCount)))))) args) ;; Wait until some child process sets the answer to nil, ;; or until all child processes are done. (mp:process-wait "Checking wait status" #'(lambda () (or (null ,flag) (zerop ,childProcessCount)))) ;; Return the value the children have computed. ,flag))) ;;; For Testing (defvar time 1000000) (defun slowFalse (n &optional ct) (dotimes (x n)) nil)