;; Dense multiplication of polynomials P Q in arrays, of length n m
;; resp.  i.e. degrees n-1, m-1 to answer of degree n+m-2.  

;; Uses MULTIPROCESSING.

;;does not work. trying to simplify it.
;; can I use GATES??

;;It incorporates code from jkf, 12/2/08 that makes use of arrest
;; reasons to block/unblock a process.  RJF 12/3/08 

;;The notes at the bottom point out slowness.

(defun mul(p q)  ;; non-multiprocessing version, for comparison
  (let* ((n (length p))(m (length q))
	 (ans (make-array (+ n m -1) :initial-element 0)))
    (dotimes (i n ans)
      (dotimes (j m)
	(incf (aref ans (+ i j))(* (aref p i)(aref q j)))))))

;; example: cl-user(43): (mul #(1 1 1 1 1) #(1 1 1 1 1)) ==>
;; #(1 2 3 4 5 4 3 2 1)


;; multiprocessing version

(defstruct procdata
   process     fcn    args    done)

(defun process-function (pd)
   (loop
;     (mp:process-add-arrest-reason mp:*current-process* :done1)
     (apply (procdata-fcn pd) (procdata-args pd))
     (setf (procdata-done pd) t)))

(defun all-processes-done (&rest pds)
   (dolist (pd pds t)
     (if (not (procdata-done pd)) (return nil))))

;; this is for 2 processes

(defparameter *pd1* (make-procdata))
(defparameter *pd2* (make-procdata))

(defun setup-mp-mul ()
  (setf (procdata-process *pd1*)
	(mp:make-process "pd1" :run-reasons t))

  (setf (procdata-process *pd2*)
	(mp:process-run-function "pd2" :run-reasons t)))


(defun mul1 (amount to ans q low high proc oproc) ;; this is the inner working for each process
  (do ((from low (1+ from)))
       ((> from high) ans)
     (incf (aref ans (+ from to))
	   (* amount (aref q from))))
  (setf (procdata-done proc) t)
  ;(print proc)
  (mp:process-wait "mul1-wait" #'procdata-done oproc)					; see if the other process is done
  (mp:process-kill mp:*current-process*)  )

(defun mul0 (amount to ans q low high proc oproc) ;; this is the inner working for each process
  (do ((from low (1+ from)))
       ((> from high) ans)
     (incf (aref ans (+ from to))
	   (* amount (aref q from))))
  (setf (procdata-done proc) t)
  (mp:process-kill mp:*current-process*)  )


(defun try1(s)
  (dotimes (i 10)(print (* s i))(sleep 0.1)))

(defun try2(s this other)
  (dotimes (i 10)(print (list (* 10 s i) locks))(sleep 0.1))
  (setf (aref locks this) t)
  (mp:process-wait  "waiting";;; something or other here . wait for other lock to be set
   #'(lambda()(aref locks other))))

(setf s1 (mp:make-process :name "s1"))
(setf s2 (mp:make-process :name "s2"))

(defun try-mp()
  
  (mp:process-run-function "s1" 'try2 2)
  (mp:process-run-function "s2" 'try2 3)
  (print 'started)
  )

(defvar locks (make-array 2 :initial-element nil))
(defun try-mpx()
   (setf locks #(nil nil))
  (mp:process-run-function "s1" 'try2 2 0 1)
  (mp:process-run-function "s2" 'try2 3 1 0)
  (print 'started)
  )



(defun mul-mp(p q) ;; two processor version, multiply polynomials p and q
  (let* ((n (length p))(m (length q))
	 (mm1 (1- m))
		 (ans (make-array (+ n m -1) :initial-element 0))
	 (pi1 0) ; will be ith coefficient in polynomial p
	 (k (ash m -1))			; where to split the task into two
	  (kp1 (1+ k))

	 (args1 (list 0 0 ans q 0   k *pd1* *pd2*)) ;bottom half args to mul1
	 (args2 (list 0 0 ans q (1+ k)   (1- m) *pd2* *pd1*))) ;top half to mul1
    (dotimes (i n ans)
      (setf pi1 (aref p i))
					; (format t "~%args: ~s~% ~s" args1 args2)
      (setf (procdata-done *pd1*) nil)
      (setf (procdata-done *pd2*) nil)
      (mp:process-run-function "*pd1*" 'mul0 pi1 i ans q 0 k *pd1* *pd2*) 
      (mp:process-run-function "*pd2*" 'mul1 pi1 i ans q kp1 mm1 *pd1* *pd2*)
    (format t "~%after step ~s ans=~%~s" i ans)      
      ;; actually, all we need is for pd2 to finish and wait for pd1.
      ;; we don't need pd1 to wait for anything.
      ;;; no no, we need another process, something like all-processes-done...see mpmult..
      
      )

    ans))
#|


;;cl-user(180):  (setf a (make-array 10 :initial-element 1)) ; polynomial with all 1 coefficients
#(1 1 1 1 1 1 1 1 1 1)
cl-user(195):  (setup-mp-mul)
mul1
cl-user(196): (time (mul-mp a a))
; cpu time (non-gc) 0 msec user, 0 msec system
; cpu time (gc)     0 msec user, 0 msec system
; cpu time (total)  0 msec user, 0 msec system
; real time  19,812 msec
; space allocation:
;  151 cons cells, 120 other bytes, 0 static bytes
#(1 2 3 4 5 6 7 8 9 10 ...)

;;; um, 19.8 seconds realtime!!! 0 sec runtime.
;;; The answer is correct.

On windows XP, pentium 4, excl::*common-lisp-version* value: "8.0 [Windows] (Oct 23, 2006 22:40)"

It is faster, but still 8.7 seconds on same windows XP machine with
International Allegro CL Free Express Edition
8.1 [Windows] (Dec 1, 2008 7:19)
Copyright (C) 1985-2007, Franz Inc., Oakland, CA, USA.  All Rights Reserved.

This development copy of Allegro CL is licensed to:
   Trial User

CG version 1.103.2.10 / IDE version 1.103.2.15
Loaded options from C:\Documents and Settings\fateman\My Documents\allegro-prefs-8-1-express.cl.


|#




#|  Really what we want is described succinctly in Gabriel's Qlambda paper:

I quote:


"The obvious choice for a multi-processing primitive for Lisp is one
which evaluates arguments to a lambda-form in parallel. QLET serves
this purpose. Its form is:

(QLET pred ((X_1 arg_1)... (x_n arg_n)) . body)

Pred is a predicate that is evaluated before any other action
regarding this form is taken; it is assumed to evaluate to one of: 0,
EAGER, or something else.  If pred evaluates to 0, then the QLET acts
exactly as a LET. That is, the arguments arg_1 . .. arg_n are
evaluated as usual and their values bound to x_1 . . . x_n,
respectively.  If pred evaluates to non-(), then the QLET will cause
some multi-processing to happen. Assume pred returns something other
than () or EAGER. Then processes are spawned, one for each arg_i. The
process evaluating the QLET goes into a wait state: When all of the
values arg_1 ... arg_n are available, their values are bound to x_1
... x_n, respectively, and each form in the list of forms, body, is
evaluated.  Assume pred returns EAGER. Then QLET acts exactly as
above, except that the process evaluating the QLET does not wait: It
proceeds to evaluate the forms in body. But if in evaluating the forms
in body the value of one of the arguments is required, arg_i, the
process evaluating the QLET waits. If that value has been supplied
already, it is simply used.  To implement EAGER binding, the value of
the EAGER variables could be set to an 'empty' value, which could
either be an empty memory location, ..... "
|#