gistfile1.lisp

;the easy way - pomoci co-dolist ktere obsahuje funkci barrier
(defvar c1  (make-array '(3 3) :initial-contents '((1 0 0)
                                                   (0 1 0)
                                                   (0 0 1))))
(defvar c2  (make-array '(3 3) :initial-contents '((2 0 0)
                                                   (0 1 0)
                                                   (0 0 1))))
(defvar c3  (make-array '(3 3) :initial-contents '((3 0 0)
                                                   (0 1 0)
                                                   (0 0 1))))
(defvar c4  (make-array '(3 3) :initial-contents '((4 0 0)
                                                   (0 1 0)
                                                   (0 0 1))))
(defvar c5  (make-array '(3 3) :initial-contents '((5 0 0)
                                                   (0 1 0)
                                                   (0 0 1))))


(defun co-multiply-matrix (a b)
  (format t "nasobeni matic ~A ~A ~%" a b)
  (let ((result (make-array (list (array-dimension a 0) 
                                  (array-dimension b 1)))))
  (co-dotimes (x (array-dimension a 0))
    (co-dotimes (y (array-dimension b 1))
      (setf (aref result x y) 
            (let ((help 0))
              (co-dotimes (z (array-dimension a 1))
                (incf help (* (aref a x z) (aref b z y))))
             help))))result))

;idea - mejme pole matic +matices+. pro kazdou dvojici poli vytvorime proces ktery dvojici vynasobi, 
;       vysledek zapise na pozici prvniho z dvojice a druheho vynuluje.
;       Pockame az tak udelaji vsechny procesy.
;       Pak se vsechny nevynulovane prvky posunou smerem k zacatku pole, a proces se opakuje dokud nam nezbyde jen jeden prvek, ktery je vysledkem.

;provedeni - seznam +matices+ si prevedu na pole +matices-array+. Spoctu v kolika krocich dojdu k vysledku (je to logaritmus o zakladu 2 z poctu prvku zaokrouhlen nahoru), ulozim do +runs+
;            spoctu pocet procesu ktere budou potreba pro zacatek, pro kazdou dvojici jeden pripadne jeden pro "lichou" matici
;            spustim procesy
;            pokud proces neni pro "lichou" matici, vynasobi sve dva pridelene elementy a zapise vysledek na pozici prvniho, druhy nahradi nilem
;            bariera
;            ted nastane komprimace pole +matices-array+. Kazdy proces prepise svuj vysledek na policko o polovinu mensi, protoze pocet matic se kazdym krokem deli 2ma.
;            musi pritom ale pockat az je policko prazdne (await), jinak by mohl prepsat vysledek jineho procesu, ktery stale jeste ceka na prepsani.
;            bariera
;            opakujeme +runs+krat
;            vratime prvni prvek (touto dobou jiz v poli je pouze prvni prvek.
(defun co-multiply-matices (&rest matices)
  (let* ((size (length matices))
         ;je potreba 1 proces na kazdou dvojici matic ktera je na vstupu. Pokud je matic lichy pocet, je pro posledni "lichou" matici vytvoren taktez.
         (processes (ceiling (/ size 2)))
         (matices-array (make-array size :initial-contents matices))
         (runs (ceiling (log size 2))))
;spustime processes procesu.
        (format t "pojedeme ~Akrat, protoze mame ~A procesu pro ~A prvku~%~%" runs processes size)
    (co-dotimes (i processes)
;procesy musi vykonat log_2 processes kroku, zaokrouhleno nahoru
      (let ((served-element (* 2 i)))
        (dotimes (times runs)
          (format t "proces ~A, krok ~A - obsluhuje ~A ~%" i times served-element)
          (if (array-in-bounds-p matices-array (+ 1 served-element))
              (if (aref matices-array (+ 1 served-element))
              (progn
                (setf (aref matices-array served-element) 
                      (co-multiply-matrix (aref matices-array served-element)
                                        (aref matices-array (+ 1 served-element))))
                (setf (aref matices-array (+ 1 served-element)) NIL))))
          (format t "bariera dosazena procesem ~A v kroku ~A ~%" i times)
          (barrier)
          (if (not (= i 0))
              (progn
                (await (not (aref matices-array i)))
                (setf (aref matices-array i) (aref matices-array served-element))
                (setf (aref matices-array served-element) NIL)))
          (format t "barriera 2 dosazena procesem ~A v kroku ~A ~%" i times)
          (barrier)
          )))(aref matices-array 0)))