replaced log-line, fixed post-increment addressing bug

;emulator for the MSP430, written to help solve the final level in the Matasano/Square CTF at https://microcorruption.com/

;data structure plans:
;memory to be represented as a large array of bytes
;registers as a much smaller array of words

(ql:quickload "cl-utilities")

(use-package :cl-utilities) ;purely for split-sequence

(defvar *log-stream* *standard-output*)

(defun log-text (&rest args)
  (print (reduce #'(lambda (current next)
		     (if (integerp next)
			 (concatenate 'string current ": " (format nil "~4,'0x" next))
			 (concatenate 'string current next)))
		 args
		 :initial-value "")
	 *log-stream*)
  t)

(defvar *reg* (make-array 16 :element-type '(UNSIGNED-BYTE 16)))

(defvar *mem* (make-array 65536 :element-type '(UNSIGNED-BYTE 8)))

(defvar *input*)

(defvar *console* "console:")

(defvar *err*)

(defvar *dep* nil)

(defvar *dep-table* 0)

(defvar *unlocked* nil)

(defun mem (idx)
  (elt *mem* idx))

(defun reg (idx)
  (elt *reg* idx))

(defun flag (idx)
  (ldb (byte 1 idx) (reg 2)))

(defun get-c ()
  (ldb (byte 1 0) (reg 2)))

(defun set-c (int)
  (setf (elt *reg* 2) (dpb int (byte 1 0) (reg 2))))

(defun get-z ()
  (ldb (byte 1 1) (reg 2)))

(defun set-z (int)
  (setf (elt *reg* 2) (dpb int (byte 1 1) (reg 2))))

(defun get-n ()
  (ldb (byte 1 2) (reg 2)))

(defun set-n (int)
  (setf (elt *reg* 2) (dpb int (byte 1 2) (reg 2))))

(defun get-v ()
  (ldb (byte 1 8) (reg 2)))

(defun set-v (int)
  (setf (elt *reg* 2) (dpb int (byte 1 8) (reg 2))))

(defun bytes-to-word (low high)
  (+ (* 256 high) low))

(defun mod+ (&rest args)
  (mod (reduce #'+ args) 65536))

(defun mod* (&rest args)
  (mod (reduce #'* args) 65536))

(defun get-mem (idx)
  ;;(print "get-mem")
  ;(format t "~4,'0x" idx)
  ;(print (bytes-to-word (mem idx) (mem (+ idx 1))))
  (bytes-to-word (mem idx) (mem (+ idx 1))))

(defun set-mem (idx int b-w)
  (log-text "set-mem" (get-mem idx))
  (log-text "idx" idx)
  (let* ((low (mod int 256))
	 (high (/ (- int low) 256)))
    (if (= b-w 0)
	(setf (elt *mem* idx) low)
	(setf (elt *mem* idx) low
	      (elt *mem* (+ idx 1)) high)))
  (log-text "res" (get-mem idx))
  t)

(defun mem-fun (idx)
  (log-text "mem-fun" idx)
  (function (lambda (int b-w) (set-mem idx int b-w))))

(defun set-reg (idx int)
  (setf (elt *reg* idx) int))
;  (let ((low (ldb (byte 8 0) int))
;	(high (ldb (byte 8 8) int)))
;    (setf (elt *reg* idx) (+ (dpb low (byte 8 8) 0)
;			     (dpb high (byte 8 0) 0)))))

(defun reg-fun (idx)
  (function (lambda (int b-w)
    (set-reg idx (trim-bw int b-w)))))

(defun get-reg (idx)
  (elt *reg* idx))
;  (let ((val (reg idx)))
;    (let ((low (ldb (byte 8 0) val))
;	  (high (ldb (byte 8 8) val)))
;      (+ (dpb low (byte 8 8) 0)
;	 (dpb high (byte 8 0) 0)))))

(defun inc-reg (idx)
  (incf (elt *reg* idx) 2))
;  (set-reg idx (+ 2 (get-reg idx))))

(defun dec-reg (idx)
  (incf (elt *reg* idx) -2))
;  (set-reg idx (+ -2 (get-reg idx))))

(defun dep-set (page val)
  (setf *dep-table* (dpb val (byte 1 page) *dep-table*)))

(defun dep-check (page)
  (ldb (byte 1 page) *dep-table*))

(defun nullp (val b-w)
  (if (= (trim-bw val b-w) 0)
      1
      0))

(defun negp (val b-w)
  (ldb (byte 1 (+ b-w 7)) val))

(defun trim-bw (val b-w)
  (ldb (byte (+ b-w 8) 0) val))

(defun main ()
  (setf *reg* (make-array 16 :element-type '(unsigned-byte 16)))
  (set-reg 0 #x4400)
  (loop repeat 1000000
     while (emu-step)
       do (if *unlocked*
	      (return-from main "victory"))))

(defun emu-step ()
  (let* ((pc (get-reg 0))
	 (bytes (subseq *mem* pc (+ pc 6))))
    (print (map 'list #'(lambda (x) (format nil "~2,'0x" x)) bytes) *log-stream*)
    (print (map 'list #'(lambda (x) (format nil "~4,'0x" x)) *reg*) *log-stream*)
    (log-text "PC" pc)
    (log-text "SP" (get-reg 1))
    (log-text "SR" (get-reg 2))
    (cond ((oddp pc) (progn (setf *err* "PC unalligned")
			    (return-from emu-step nil)))
	  ((= (ldb (byte 1 4) (get-reg 2)) 1) (progn (setf *err* "cpu-off set")
						 (return-from emu-step nil)))
	  ((= pc 16) (int-handler (ldb (byte 7 8) (get-reg 2))))
	  ((= (bytes-to-word (elt bytes 0) (elt bytes 1)) 0)
	   (progn (setf *err* "zero instruction")
			    (return-from emu-step nil)))
	  (t (instruction-decode bytes)))))

(defun int-handler (type)
  ;(print "interrupt")
  ;(print (subseq *mem* (get-reg 1) (+ 16 (get-reg 1))))
  (let ((arg1 (get-mem (+ 8 (get-reg 1))))
	(arg2 (get-mem (+ 10 (get-reg 1)))))
    (cond ((= type 0) (setf *console* (concatenate 'string *console*
						   (list (code-char (ldb (byte 8 0) arg1))))))
	  ((= type 2) (getsn arg1 arg2))
	  ((= type 3) (dep-set arg1 arg2))
	  ((= type 4) (set-reg 15 (random 65536 (make-random-state t))))
	  ((= type #x7d) (set-mem arg2 0 0)) ;assume password is always false
	  ((= type #x7e) t) ;assume passsword is always false
	  ((= type #x7f) (setf *unlocked* t)))
    (set-reg 0 (get-mem (get-reg 1)))
    (inc-reg 1)))

(defun getsn (start num)
  ;(print "getsn")
  ;(format t "~4,'0x" start)
  ;(print num)
  ;(print (car *input*))
  (let ((cur-input (car *input*)))
    (loop for i from 0 to (- (/ (length cur-input) 2) 1)
       while (<= i num)
       for char = (hex-string-to-int (subseq cur-input (* i 2) (* (+ i 1) 2)))
       do (set-mem (+ start i) char 0)))
  (setf *input* (cdr *input*)))

(defun instruction-decode (bytes)
  ;bytes to be an arry of 6 bytes, to allow for the longest possible instruction
  ;this is the entry point into the instruction decoding, will eventually call the
  ;appropriate function
  (let ((instn (bytes-to-word (elt bytes 0) (elt bytes 1)))
	(data1 (bytes-to-word (elt bytes 2) (elt bytes 3)))
	(data2 (bytes-to-word (elt bytes 4) (elt bytes 5))))
    (cond ((= (ldb (byte 4 12) instn) 1) (single-decode instn data1))
	  ((= (ldb (byte 3 13) instn) 1) (jump-decode instn))
	  ((>= (ldb (byte 4 12) instn) 4) (double-decode instn data1 data2)))))

(defun address-decode (ad dest data b-w)
  (log-text "AD" ad)
  (log-text "dest" dest)
  (log-text "ext-word" data)
  ;decodes an address for a single operand instruction
  ;returns:
  ;an integer representing the current value
  ;a function that sets the new value
  ;t if an extension word was used, nil otherwise
  (if (or (= dest 2) (= dest 3))
      (if (= dest 2)
	  (cond ((= ad 0) (values (get-reg dest)
				  (reg-fun dest)
				  nil)) ;register mode
		((= ad 1) (progn (inc-reg 0)
				 (values (get-mem data)
					 (mem-fun data)
					 t)));absolute mode
		((= ad 2) (values 4 (reg-fun dest) nil)) ;represents a constant, can't set things
		((= ad 3) (values 8 (reg-fun dest) nil)) ;as above
		(t 'nil))
	  (cond ((= ad 0) (values 0 (reg-fun dest) nil)) ;dest = 3
		((= ad 1) (values 1 (reg-fun dest) nil))
		((= ad 2) (values 2 (reg-fun dest) nil))
		((= ad 3) (values 65535 (reg-fun dest) nil))
		(t 'nil)))
      (cond ((= ad 0) (values (get-reg dest)
			      (reg-fun dest)
			      nil)) ;register mode
	    ((= ad 1) (let ((idx (mod+ (get-reg dest) data)))
			(inc-reg 0)
			(values (get-mem idx)
				(mem-fun idx)
				t))) ;index mode
	    ((= ad 2) (values (get-mem (get-reg dest))
			      (mem-fun (get-reg dest))
			      nil)) ;indirect mode
	    ((= ad 3) (progn (addr-increment dest b-w)
			     (values (get-mem (- (get-reg dest) (if (= dest 0)
								    2
								    (+ 1 (/ b-w 8)))))
				     (mem-fun (- (get-reg dest) (if (= dest 0)
								    2
								    (+ 1 (/ b-w 8)))))
				     t))) ;indirect mode with increment
	    (t 'nil))))

(defun addr-increment (idx b-w)
  (if (= 0 idx)
      (incf (elt *reg* idx) 2)
      (incf (elt *reg* idx) (+ 1 (/ b-w 8)))))

(defun single-decode (instn data)
  (log-text "single-op")
  (inc-reg 0)
  ;decodes and calls a single operand instruction
  (let ((opcode (ldb (byte 3 7) instn))
	(ad (ldb (byte 2 4) instn))
	(dest (ldb (byte 4 0) instn))
	(b-w (if (= 1 (ldb (byte 1 6) instn))
		 0
		 8)))
    (multiple-value-bind (value set-fun)
	(address-decode ad dest data b-w)
      ;(print value)
      ;(print set-fun)
      (cond ((= opcode 0) (rrc value set-fun b-w))
	    ((= opcode 1) (swpb value set-fun))
	    ((= opcode 2) (rra value set-fun b-w))
	    ((= opcode 3)  (sxt value set-fun))
	    ((= opcode 4) (psh value set-fun b-w))
	    ((= opcode 5) (call value set-fun))
	    (t 'nil)))))
	      ;RETI isn't implemented because it's not in the CTF

(defun rrc (value set-fun b-w)
  (log-text "rrc")
  (let ((carry (ldb (byte 1 0) value))
	(tmp (ash (trim-bw value b-w) -1)))
    (let ((res (dpb (get-c) (byte 1 (+ b-w 7)) tmp)))
      (funcall set-fun res b-w)
      (set-v 0)
      (set-c carry)
      (if (= (negp res b-w) 1)
	  (set-n 1))
      (if (= (nullp res b-w) 0)
	  (set-z 0)))))

(defun swpb (value set-fun)
  (log-text "swpb")
  (let ((low (ldb (byte 8 8) value))
	(high (ldb (byte 8 0) value)))
    (funcall set-fun (+ (* 256 high) low) 8)))

(defun rra (value set-fun b-w)
  (log-text "rra")
  (let ((res (ash (trim-bw value b-w) -1)))
    (funcall set-fun res b-w)
    (if (= (negp res b-w) 1)
	(set-n 1))
    (set-v 0)
    (set-z 0)))

(defun sxt (value set-fun)
(log-text "sxt")
  (let ((res (dpb (* 255 (ldb (byte 1 7) value)) (byte 8 8) value)))
    (funcall set-fun res 8)
    (set-c (if (= res 0)
	       0
	       1))
    (set-v 0)
    (set-n (negp res 8))
    (set-z (nullp res 8))))

(defun psh (value set-fun b-w)
  (log-text "psh" value)
  (dec-reg 1)
  (set-mem (get-reg 1) value b-w))

(defun call (value set-fun)
  (log-text "call")
  ;(format t "~4,'0x" value)
  (psh (get-reg 0) nil 8)
  (set-reg 0 value))

(defun jump-decode (instn)
  (log-text "jump" instn)
  (print (get-reg 2) *log-stream*)
  (let ((type (ldb (byte 3 10) instn))
	(offset (ldb (byte 10 0) instn))
	(z (flag 1))
	(c (flag 0))
	(n (flag 2))
	(v (flag 8)))
    (cond ((= type 0) (if (= z 0)
			  (jmp offset)
			  (inc-reg 0)))
	  ((= type 1) (if (= z 1)
			  (jmp offset)
			  (inc-reg 0)))
	  ((= type 2) (if (= c 0)
			  (jmp offset)
			  (inc-reg 0)))
	  ((= type 3) (if (= c 1) (jmp offset)
			  (inc-reg 0)))
	  ((= type 4) (if (= n 1) (jmp offset)
			  (inc-reg 0)))
	  ((= type 5) (if (= n v) (jmp offset)
			  (inc-reg 0)))
	  ((= type 6) (if (/= n v) (jmp offset)
			  (inc-reg 0)))
	  ((= type 7) (jmp offset)))))

(defun jmp (offset)
  ;(print offset)
  ;(print (ldb (byte 9 0) offset))
  ;(print (* (ldb (byte 1 9) offset) 1024))
  ;(print (- (* 2 (- (ldb (byte 9 0) offset)
;		    (* (ldb (byte 1 9) offset) 512)))))
  (set-reg 0 (+ (get-reg 0) 2
		(* 2 (- (ldb (byte 9 0) offset)
			(* (ldb (byte 1 9) offset) 512)))))
  t)

(defun double-decode (instn data1 data2)
  (log-text "double-op")
  (inc-reg 0)
  (let ((opcode (ldb (byte 4 12) instn))
	(source (ldb (byte 4 8) instn))
	(ad (ldb (byte 1 7) instn))
	(as (ldb (byte 2 4) instn))
	(dest (ldb (byte 4 0) instn))
	(b-w (if (= 1 (ldb (byte 1 6) instn))
		 0
		 8)))
    (multiple-value-bind (source-val source-fun ext-used)
	(address-decode as source data1 b-w)
      (multiple-value-bind (dest-val dest-fun)
	  (address-decode ad dest (if ext-used
				      data2    ;use the second extension word if
				      data1)   ;the first was used in the source
			  b-w)
;      (let* ((source-lst (multiple-value-list (address-decode as source data1)))
;	     (source-val (car source-lst)))
;	;(print source-lst)
	;(log-text "source" source-val)
	;(format t "~4,'0x" source-val)
	;(log-text "dest" dest-val)
	;(format t "~4,'0x" dest-val)
	(cond ((= opcode 4) (mov source-val dest-fun b-w))
	      ((= opcode 5) (add source-val dest-val dest-fun b-w))
	      ((= opcode 6) (addc source-val dest-val dest-fun b-w))
	      ((= opcode 7) (subc source-val dest-val dest-fun b-w))
	      ((= opcode 8) (sub source-val dest-val dest-fun b-w))
	      ((= opcode 9) (cmp source-val dest-val b-w))
	      ((= opcode 10) (dadd source-val dest-val dest-fun b-w))
	      ((= opcode 11) (emu-bit source-val dest-val b-w))
	      ((= opcode 12) (bic source-val dest-val dest-fun b-w))
	      ((= opcode 13) (bis source-val dest-val dest-fun b-w))
	      ((= opcode 14) (xor source-val dest-val dest-fun b-w))
	      ((= opcode 15) (emu-and source-val dest-val dest-fun b-w))
	      (t 'nil))))))

(defun mov (val dest-fun b-w)
  (log-text "mov" val)
 ;(format t "~4,'0x"  val)
;  (print dest-fun)
  (log-text "byte-word" b-w)
  (funcall dest-fun val b-w))

(defun add-flags (res b-w)
  (set-c (ldb (byte 1 (+ b-w 8)) res))
  (set-v 0)
  (set-n (negp res b-w))
  (set-z (nullp res b-w)))

(defun add (source-val dest-val dest-fun b-w)
  (log-text "add")
  (log-text "source" source-val)
 ;(format t "~4,'0x" source-val)
  (log-text "dest" dest-val)
 ;(format t "~4,'0x" dest-val)
  (log-text "byte-word" b-w)
  (let ((res (+ (trim-bw source-val b-w) (trim-bw dest-val b-w))))
    (add-flags res b-w)
    (funcall dest-fun res b-w)))

(defun addc (source-val dest-val dest-fun b-w)
  (log-text "addc")
  (let ((res (+ (trim-bw source-val b-w) (trim-bw dest-val b-w) (get-c))))
    (add-flags res b-w)
    (funcall dest-fun res b-w)))

(defun subc (source-val dest-val dest-fun b-w)
  (log-text "subc")
  (let ((res (+ (trim-bw dest-val b-w) (lognot (trim-bw source-val b-w)) (get-c) 1))) ;random +1 for bug compat
    (add-flags res b-w)
    (funcall dest-fun res b-w)))

(defun sub (source-val dest-val dest-fun b-w)
  (log-text "sub")
  (let ((res (+ (trim-bw dest-val b-w) (trim-bw (lognot source-val) b-w) 1)))
    (add-flags res b-w)
    (funcall dest-fun res b-w)))

(defun cmp (source-val dest-val b-w)
  (log-text "cmp" source-val dest-val)
  ;(format t "~4,'0x"  source-val)
  ;(format t "~4,'0x"  dest-val)
  (log-text "byte-word" b-w)
  (let ((res (+ (trim-bw dest-val b-w) (trim-bw (lognot source-val) b-w) 1)))
    (add-flags res b-w))
  (log-text "SR" (get-reg 2)))

(defun dadd (source-val dest-val dest-fun b-w)
  (log-text "dadd")
  (let ((trim-s (trim-bw source-val b-w))
	(trim-d (trim-bw dest-val b-w)))
    (let ((res (loop for i in (list 0 4 8 12)
		  for c = 0 then (if (>= tmp 10)
				     1
				     0)
		  for tmp = (+ (ldb (byte 4 i) trim-s)
			       (ldb (byte 4 i) trim-d)
			       c)
		  for tmp2 = (if (>= tmp 10)
				 (- tmp 10)
				 tmp)
		  for val = tmp2 then (dpb tmp2 (byte 4 i) val)
		  finally (progn (set-c c)
				 (if (ldb (byte 1 3) tmp)
				     (set-n 1))
				 (return val)))))
      (funcall dest-fun res b-w))))

(defun emu-bit (source-val dest-val b-w)
  (log-text "emu-bit")
  (let ((res (logand (trim-bw source-val b-w) (trim-bw dest-val b-w))))
    (set-v 0)
    (set-n (ldb (byte 1 (+ b-w 7)) res))
    (set-z (nullp res b-w))
    (set-c (nullp res b-w))))

(defun bic (source-val dest-val dest-fun b-w)
  (log-text "bic")
  (let ((res (logand (lognot (trim-bw source-val b-w)) (trim-bw dest-val b-w))))
    (funcall dest-fun res b-w)))

(defun bis (source-val dest-val dest-fun b-w)
  (log-text "bis")
  (funcall dest-fun (logior (trim-bw source-val b-w) (trim-bw dest-val b-w)) b-w))

(defun xor (source-val dest-val dest-fun b-w)
  (log-text "xor")
  (let ((res (logxor (trim-bw source-val b-w) (trim-bw dest-val b-w))))
    (funcall dest-fun res b-w)
    (set-v 0)
    (set-n (ldb (byte 1 (+ b-w 7)) res))
    (set-z (nullp res b-w))
    (set-c (nullp res b-w))))

(defun emu-and (source-val dest-val dest-fun b-w)
  (log-text "emu-and")
  (let ((res (logand (trim-bw source-val b-w) (trim-bw dest-val b-w))))
    (funcall dest-fun res b-w)
    (set-v 0)
    (set-n (ldb (byte 1 (+ b-w 7)) res))
    (set-z (nullp res b-w))
    (set-c (nullp res b-w))))

;start of file importing code
(defun hex-char-to-int (chr)
  (let ((hex-index "0123456789abcdef")
        (int-index #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)))
    (elt int-index (position chr hex-index))))

(defun hex-string-to-int (str)
  (if (equal str "")
      0
      (let ((down-str (string-downcase str)))
	(loop for i from 0 to (- (length str) 1)
	   for res = (hex-char-to-int (elt down-str i)) then (+ (* res 16) (hex-char-to-int (elt down-str i)))
	   finally (return res)))))

(defun import-file (file)
  (setf *mem* (make-array 65536 :element-type '(unsigned-byte 8)))
  (with-open-file (in file)
    (loop for line = (read-line in nil)
       while line
       do (if (not (equal #\* (elt line 8)))
	      (let* ((split-line (split-sequence #\: line))
		     (offset (hex-string-to-int (car split-line)))
		     (blocks (subseq (split-sequence #\space (cadr split-line)) 3 11)))
		(loop for i from 0 to 7
		   for block = (elt blocks i)
		   do (set-mem (+ offset (* i 2)) (block-val block) 8)))))))

(defun block-val (str)
  (hex-string-to-int
   (concatenate 'string (subseq str 2 4) (subseq str 0 2))))

(defun reset ()
  (setf *reg* (make-array 16 :element-type '(UNSIGNED-BYTE 16)))
  (setf *mem* (make-array 65536 :element-type '(UNSIGNED-BYTE 8)))
  (setf *err* "null")
  (setf *console* "console:")
  (setf *unlocked* nil))

(defun run-level (file-name input)
  (reset)
  (print "start of run")
  ;(setf *log-stream* *standard-output*)
  (setf *log-stream* (open "C:\\ben\\log.txt" :direction :output :if-exists :supersede :SHARING :external))
  (import-file file-name)
  (setf *input* input)
  (main)
  (print file-name)
  (print *console*)
  (print "error:")
  (print *err*)
  (print "unlocked?")
  (print *unlocked*))

;emulator for the MSP430, written to help solve the final level in the Matasano/Square CTF at https://microcorruption.com/

;data structure plans:
;memory to be represented as a large array of bytes
;registers as a much smaller array of words

;some utilities, that would be in a library normally

(ql:quickload "cl-utilities")

(use-package :cl-utilities) ;purely for split-sequence

(defun hex-char-to-int (chr)
  (let ((hex-index "0123456789abcdef")
        (int-index #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)))
    (elt int-index (position chr hex-index))))

(defun hex-string-to-int (str)
  (if (equal str "")
      0
      (let ((down-str (string-downcase str)))
	(loop for i from 0 to (- (length str) 1)
	   for res = (hex-char-to-int (elt down-str i)) then (+ (* res 16) (hex-char-to-int (elt down-str i)))
	   finally (return res)))))

(defun 4bits-to-hex-char (bits)
  (let ((hex-index "0123456789abcdef")
        (int-index #(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)))
    (elt hex-index (position bits int-index))))

(defun list-to-string (l)
  (with-output-to-string (s)
    (dolist (c l)
      (princ c s))))

(defun int-to-hex-string (int)
  (list-to-string
   (loop for i = int then (/ (- i (mod i 16)) 16)
       while (>= i 1)
       with res = '()
       do (push (4bits-to-hex-char (mod i 16)) res)
       finally (return res))))

;global variables

(defvar *log-stream* *standard-output*)

(defvar *reg* (make-array 16 :element-type '(UNSIGNED-BYTE 16)))

(defvar *mem* (make-array 65536 :element-type '(UNSIGNED-BYTE 8)))

(defvar *input*)

(defvar *console* "console:")

(defvar *err*)

(defvar *dep* nil)

(defvar *dep-table* 0)

(defvar *unlocked* nil)

(defun log-line (arg)
  (if (integerp arg)
      (print (format nil "~4,'0x" arg) *log-stream*)
      (print arg *log-stream*))
  t)

;some utility functions specific to the emulator
(defun mem (idx)
  (elt *mem* idx))

(defun reg (idx)
  (elt *reg* idx))

(defun flag (idx)
  (ldb (byte 1 idx) (reg 2)))

(defun get-c ()
  (ldb (byte 1 0) (reg 2)))

(defun set-c (int)
  (setf (elt *reg* 2) (dpb int (byte 1 0) (reg 2))))

(defun get-z ()
  (ldb (byte 1 1) (reg 2)))

(defun set-z (int)
  (setf (elt *reg* 2) (dpb int (byte 1 1) (reg 2))))

(defun get-n ()
  (ldb (byte 1 2) (reg 2)))

(defun set-n (int)
  (setf (elt *reg* 2) (dpb int (byte 1 2) (reg 2))))

(defun get-v ()
  (ldb (byte 1 8) (reg 2)))

(defun set-v (int)
  (setf (elt *reg* 2) (dpb int (byte 1 8) (reg 2))))

(defun bytes-to-word (low high)
  (+ (* 256 high) low))

(defun mod+ (&rest args)
  (mod (reduce #'+ args) 65536))

(defun mod* (&rest args)
  (mod (reduce #'* args) 65536))

(defun get-mem (idx)
;  (log-line "get-mem")
 ; (log-line idx)
  ;(log-line (bytes-to-word (mem idx) (mem (+ idx 1))))
  (bytes-to-word (mem idx) (mem (+ idx 1))))

(defun set-mem (idx int b-w)
  (log-line "set-mem")
 (log-line (get-mem idx))
  (log-line "idx")
 (log-line idx)
  (let* ((low (mod int 256))
	 (high (/ (- int low) 256)))
    (if (= b-w 0)
	(setf (elt *mem* idx) low)
	(setf (elt *mem* idx) low
	      (elt *mem* (+ idx 1)) high)))
  (log-line "res")
  (log-line (get-mem idx))
  t)

(defun mem-fun (idx)
  (function (lambda (int b-w) (set-mem idx int b-w))))

(defun set-reg (idx int)
  (setf (elt *reg* idx) int))
;  (let ((low (ldb (byte 8 0) int))
;	(high (ldb (byte 8 8) int)))
;    (setf (elt *reg* idx) (+ (dpb low (byte 8 8) 0)
;			     (dpb high (byte 8 0) 0)))))

(defun reg-fun (idx)
  (function (lambda (int b-w)
    (set-reg idx (trim-bw int b-w)))))

(defun get-reg (idx)
  (elt *reg* idx))
;  (let ((val (reg idx)))
;    (let ((low (ldb (byte 8 0) val))
;	  (high (ldb (byte 8 8) val)))
;      (+ (dpb low (byte 8 8) 0)
;	 (dpb high (byte 8 0) 0)))))

(defun inc-reg (idx)
  (incf (elt *reg* idx) 2))
;  (set-reg idx (+ 2 (get-reg idx))))

(defun dec-reg (idx)
  (incf (elt *reg* idx) -2))
;  (set-reg idx (+ -2 (get-reg idx))))

(defun dep-set (page val)
  (setf *dep-table* (dpb val (byte 1 page) *dep-table*)))

(defun dep-check (page)
  (ldb (byte 1 page) *dep-table*))

(defun nullp (val b-w)
  (if (= (trim-bw val b-w) 0)
      1
      0))

(defun negp (val b-w)
  (ldb (byte 1 (+ b-w 7)) val))

(defun trim-bw (val b-w)
  (ldb (byte (+ b-w 8) 0) val))

;start of actual emulator
(defun main ()
  (setf *reg* (make-array 16 :element-type '(unsigned-byte 16)))
  (set-reg 0 #x4400)
  (loop repeat 1000000
     while (emu-step)
       do (if *unlocked*
	      (return-from main "victory"))))

(defun emu-step ()
  (let* ((pc (get-reg 0))
	 (bytes (subseq *mem* pc (+ pc 6))))
    (log-line bytes)
    (log-line "PC")
    (log-line pc)
    (log-line "sp")
    (log-line (get-reg 1))
    (log-line "sr")
    (log-line (get-reg 2))
    (log-line "registers")
    (log-line *reg*)
    (cond ((oddp pc) (progn (setf *err* "PC unalligned")
			    (return-from emu-step nil)))
	  ((= (ldb (byte 1 4) (get-reg 2)) 1) (progn (setf *err* "cpu-off set")
						 (return-from emu-step nil)))
	  ((= pc 16) (int-handler (ldb (byte 7 8) (get-reg 2))))
	  ((= (bytes-to-word (elt bytes 0) (elt bytes 1)) 0)
	   (progn (setf *err* "zero instruction")
			    (return-from emu-step nil)))
	  (t (instruction-decode bytes)))
    ))

(defun int-handler (type)
  (log-line "interrupt")
  (log-line (subseq *mem* (get-reg 1) (+ 16 (get-reg 1))))
  (let ((arg1 (get-mem (+ 8 (get-reg 1))))
	(arg2 (get-mem (+ 10 (get-reg 1)))))
    (cond ((= type 0) (setf *console* (concatenate 'string *console*
						   (list (code-char (ldb (byte 8 0) arg1))))))
	  ((= type 2) (getsn arg1 arg2))
	  ((= type 3) (dep-set arg1 arg2))
	  ((= type 4) (set-reg 15 (random 65536 (make-random-state t))))
	  ((= type #x7d) (set-mem arg2 0 0)) ;assume password is always false
	  ((= type #x7e) t) ;assume passsword is always false
	  ((= type #x7f) (setf *unlocked* t)))
    (set-reg 0 (get-mem (get-reg 1)))
    (inc-reg 1)))

(defun getsn (start num)
  (log-line "getsn")
  (log-line start)
  (log-line num)
  (log-line (car *input*))
  (let ((cur-input (car *input*)))
    (loop for i from 0 to (- (/ (length cur-input) 2) 1)
       while (<= i num)
       for char = (hex-string-to-int (subseq cur-input (* i 2) (* (+ i 1) 2)))
       do (set-mem (+ start i) char 0)))
  (setf *input* (cdr *input*)))

(defun instruction-decode (bytes)
  ;bytes to be an arry of 6 bytes, to allow for the longest possible instruction
  ;this is the entry point into the instruction decoding, will eventually call the
  ;appropriate function
  (let ((instn (bytes-to-word (elt bytes 0) (elt bytes 1)))
	(data1 (bytes-to-word (elt bytes 2) (elt bytes 3)))
	(data2 (bytes-to-word (elt bytes 4) (elt bytes 5))))
    (cond ((= (ldb (byte 4 12) instn) 1) (single-decode instn data1))
	  ((= (ldb (byte 3 13) instn) 1) (jump-decode instn))
	  ((>= (ldb (byte 4 12) instn) 4) (double-decode instn data1 data2)))))

(defun address-decode (ad dest data b-w)
  (log-line ad)
  (log-line dest)
  (log-line data)
  ;decodes an address for a single operand instruction
  ;returns an integer representing the current value and a function that sets the new value
  (if (or (= dest 2) (= dest 3))
      (if (= dest 2)
	  (cond ((= ad 0) (values (get-reg dest)
				  (reg-fun dest)
				  0)) ;register mode
		((= ad 1) (progn (inc-reg 0)
				 (values (get-mem data)
					 (mem-fun data)
					 1)));absolute mode
		((= ad 2) (values 4 (reg-fun dest) 0)) ;represents a constant, can't set things
		((= ad 3) (values 8 (reg-fun dest) 0)) ;as above
		(t 'nil))
	  (cond ((= ad 0) (values 0 (reg-fun dest) 0)) ;dest = 3
		((= ad 1) (values 1 (reg-fun dest) 0))
		((= ad 2) (values 2 (reg-fun dest) 0))
		((= ad 3) (values 65535 (reg-fun dest) 0))
		(t 'nil)))
      (cond ((= ad 0) (values (get-reg dest)
			      (reg-fun dest)
			      0)) ;register mode
	    ((= ad 1) (let ((idx (mod+ (get-reg dest) data)))
			(inc-reg 0)
			(values (get-mem idx)
				(mem-fun idx)
				1))) ;index mode
	    ((= ad 2) (values (get-mem (get-reg dest))
			      (mem-fun (get-reg dest))
			      0)) ;indirect mode
	    ((= ad 3) (progn (addr-increment dest b-w)
			     (values (get-mem (- (get-reg dest) (if (= dest 0)
								    2
								    (+ 1 (/ b-w 8)))))
				     (mem-fun (- (get-reg dest) (if (= dest 0)
								    2
								    (+ 1 (/ b-w 8)))))
				     0))) ;indirect mode with increment
	    (t 'nil))))

(defun addr-increment (idx b-w)
  (if (= 0 idx)
      (incf (elt *reg* idx) 2)
      (incf (elt *reg* idx) (+ 1 (/ b-w 8)))))

(defun single-decode (instn data)
  (log-line "single-op")
  (inc-reg 0)
  ;decodes and calls a single operand instruction
  (let ((opcode (ldb (byte 3 7) instn))
	(ad (ldb (byte 2 4) instn))
	(dest (ldb (byte 4 0) instn))
	(b-w (if (= 1 (ldb (byte 1 6) instn))
		 0
		 8)))
    (multiple-value-bind (value set-fun)
	(address-decode ad dest data b-w)
      ;(log-line value)
      ;(log-line set-fun)
      (cond ((= opcode 0) (rrc value set-fun b-w))
	    ((= opcode 1) (swpb value set-fun))
	    ((= opcode 2) (rra value set-fun b-w))
	    ((= opcode 3)  (sxt value set-fun))
	    ((= opcode 4) (psh value set-fun b-w))
	    ((= opcode 5) (call value set-fun))
	    (t 'nil)))))
	      ;RETI isn't implemented because it's not in the CTF

(defun rrc (value set-fun b-w)
  (log-line "rrc")
  (let ((carry (ldb (byte 1 0) value))
	(tmp (ash (trim-bw value b-w) -1)))
    (let ((res (dpb (get-c) (byte 1 (+ b-w 7)) tmp)))
      (funcall set-fun res b-w)
      (set-v 0)
      (set-c carry)
      (if (= (negp res b-w) 1)
	  (set-n 1))
      (if (= (nullp res b-w) 0)
	  (set-z 0)))))

(defun swpb (value set-fun)
  (log-line "swpb")
  (let ((low (ldb (byte 8 8) value))
	(high (ldb (byte 8 0) value)))
    (funcall set-fun (+ (* 256 high) low) 8)))

(defun rra (value set-fun b-w)
  (log-line "rra")
  (let ((res (ash (trim-bw value b-w) -1)))
    (funcall set-fun res b-w)
    (if (= (negp res b-w) 1)
	(set-n 1))
    (set-v 0)
    (set-z 0)))

(defun sxt (value set-fun)
  (log-line "sxt")
  (let ((res (dpb (* 255 (ldb (byte 1 7) value)) (byte 8 8) value)))
    (funcall set-fun res 8)
    (set-c (if (= res 0)
	       0
	       1))
    (set-v 0)
    (set-n (negp res 8))
    (set-z (nullp res 8))))

(defun psh (value set-fun b-w)
  (log-line "psh")
  (log-line value)
  (dec-reg 1)
  (set-mem (get-reg 1) value b-w))

(defun call (value set-fun)
  (log-line "call")
  (log-line value)
  (psh (get-reg 0) nil 8)
  (set-reg 0 value))

(defun jump-decode (instn)
  (log-line "jump")
  (log-line instn)
  (log-line (get-reg 2))
  (let ((type (ldb (byte 3 10) instn))
	(offset (ldb (byte 10 0) instn))
	(z (flag 1))
	(c (flag 0))
	(n (flag 2))
	(v (flag 8)))
    (cond ((= type 0) (if (= z 0)
			  (jmp offset)
			  (inc-reg 0)))
	  ((= type 1) (if (= z 1)
			  (jmp offset)
			  (inc-reg 0)))
	  ((= type 2) (if (= c 0)
			  (jmp offset)
			  (inc-reg 0)))
	  ((= type 3) (if (= c 1) (jmp offset)
			  (inc-reg 0)))
	  ((= type 4) (if (= n 1) (jmp offset)
			  (inc-reg 0)))
	  ((= type 5) (if (= n v) (jmp offset)
			  (inc-reg 0)))
	  ((= type 6) (if (/= n v) (jmp offset)
			  (inc-reg 0)))
	  ((= type 7) (jmp offset)))))

(defun jmp (offset)
  (log-line offset)
  (log-line (ldb (byte 9 0) offset))
  (log-line (* (ldb (byte 1 9) offset) 1024))
  (log-line (- (* 2 (- (ldb (byte 9 0) offset)
		       (* (ldb (byte 1 9) offset) 512)))))
  (set-reg 0 (+ (get-reg 0) 2
		(* 2 (- (ldb (byte 9 0) offset)
			(* (ldb (byte 1 9) offset) 512)))))
  t)

(defun double-decode (instn data1 data2)
  (log-line "double-op")
  (inc-reg 0)
  (let ((opcode (ldb (byte 4 12) instn))
	(source (ldb (byte 4 8) instn))
	(ad (ldb (byte 1 7) instn))
	(as (ldb (byte 2 4) instn))
	(dest (ldb (byte 4 0) instn))
	(b-w (if (= 1 (ldb (byte 1 6) instn))
		 0
		 8)))
    (multiple-value-bind (source-val source-fun data-offset)
	(address-decode as source data1 b-w)
      (multiple-value-bind (dest-val dest-fun junk-val)
	  (address-decode ad dest (if (= data-offset 1)
				      data2    ;use the second extension word if
				      data1)
			  b-w)  ;the first was used in the source
;      (let* ((source-lst (multiple-value-list (address-decode as source data1)))
;	     (source-val (car source-lst)))
	;(log-line source-lst)
	(log-line "source")
	(log-line source-val)
	(log-line "dest")
	(log-line dest-val)
	(cond ((= opcode 4) (mov source-val dest-fun b-w))
	      ((= opcode 5) (add source-val dest-val dest-fun b-w))
	      ((= opcode 6) (addc source-val dest-val dest-fun b-w))
	      ((= opcode 7) (subc source-val dest-val dest-fun b-w))
	      ((= opcode 8) (sub source-val dest-val dest-fun b-w))
	      ((= opcode 9) (cmp source-val dest-val b-w))
	      ((= opcode 10) (dadd source-val dest-val dest-fun b-w))
	      ((= opcode 11) (emu-bit source-val dest-val b-w))
	      ((= opcode 12) (bic source-val dest-val dest-fun b-w))
	      ((= opcode 13) (bis source-val dest-val dest-fun b-w))
	      ((= opcode 14) (xor source-val dest-val dest-fun b-w))
	      ((= opcode 15) (emu-and source-val dest-val dest-fun b-w))
	      (t 'nil))))))

(defun mov (val dest-fun b-w)
  (log-line "mov")
 (log-line  val)
  (log-line dest-fun)
  (log-line b-w)
  (funcall dest-fun val b-w))

(defun add-flags (res b-w)
  (set-c (ldb (byte 1 (+ b-w 8)) res))
  (set-v 0)
  (set-n (negp res b-w))
  (set-z (nullp res b-w)))

(defun add (source-val dest-val dest-fun b-w)
  (log-line "add")
  (log-line "source")
  (log-line source-val)
  (log-line "dest")
  (log-line dest-val)
  (log-line b-w)
  (let ((res (+ (trim-bw source-val b-w) (trim-bw dest-val b-w))))
    (add-flags res b-w)
    (funcall dest-fun res b-w)))

(defun addc (source-val dest-val dest-fun b-w)
  (log-line "addc")
  (let ((res (+ (trim-bw source-val b-w) (trim-bw dest-val b-w) (get-c))))
    (add-flags res b-w)
    (funcall dest-fun res b-w)))

(defun subc (source-val dest-val dest-fun b-w)
  (log-line "subc")
  (let ((res (+ (trim-bw dest-val b-w) (lognot (trim-bw source-val b-w)) (get-c) 1))) ;random +1 for bug compat
    (add-flags res b-w)
    (funcall dest-fun res b-w)))

(defun sub (source-val dest-val dest-fun b-w)
  (log-line "sub")
  (let ((res (+ (trim-bw dest-val b-w) (trim-bw (lognot source-val) b-w) 1)))
    (add-flags res b-w)
    (funcall dest-fun res b-w)))

(defun cmp (source-val dest-val b-w)
  (log-line "cmp")
  (log-line  source-val)
  (log-line  dest-val)
  (log-line b-w)
  (let ((res (+ (trim-bw dest-val b-w) (trim-bw (lognot source-val) b-w) 1)))
    (add-flags res b-w))
  (log-line (get-reg 2)))

(defun dadd (source-val dest-val dest-fun b-w)
  (log-line "dadd")
  (let ((trim-s (trim-bw source-val b-w))
	(trim-d (trim-bw dest-val b-w)))
    (let ((res (loop for i in (list 0 4 8 12)
		  for c = 0 then (if (>= tmp 10)
				     1
				     0)
		  for tmp = (+ (ldb (byte 4 i) trim-s)
			       (ldb (byte 4 i) trim-d)
			       c)
		  for tmp2 = (if (>= tmp 10)
				 (- tmp 10)
				 tmp)
		  for val = tmp2 then (dpb tmp2 (byte 4 i) val)
		  finally (progn (set-c c)
				 (if (ldb (byte 1 3) tmp)
				     (set-n 1))
				 (return val)))))
      (funcall dest-fun res b-w))))

(defun emu-bit (source-val dest-val b-w)
  (log-line "emu-bit")
  (let ((res (logand (trim-bw source-val b-w) (trim-bw dest-val b-w))))
    (set-v 0)
    (set-n (ldb (byte 1 (+ b-w 7)) res))
    (set-z (nullp res b-w))
    (set-c (nullp res b-w))))

(defun bic (source-val dest-val dest-fun b-w)
  (log-line "bic")
  (let ((res (logand (lognot (trim-bw source-val b-w)) (trim-bw dest-val b-w))))
    (funcall dest-fun res b-w)))

(defun bis (source-val dest-val dest-fun b-w)
  (log-line "bis")
  (funcall dest-fun (logior (trim-bw source-val b-w) (trim-bw dest-val b-w)) b-w))

(defun xor (source-val dest-val dest-fun b-w)
  (log-line "xor")
  (let ((res (logxor (trim-bw source-val b-w) (trim-bw dest-val b-w))))
    (funcall dest-fun res b-w)
    (set-v 0)
    (set-n (ldb (byte 1 (+ b-w 7)) res))
    (set-z (nullp res b-w))
    (set-c (nullp res b-w))))

(defun emu-and (source-val dest-val dest-fun b-w)
  (log-line "emu-and")
  (let ((res (logand (trim-bw source-val b-w) (trim-bw dest-val b-w))))
    (funcall dest-fun res b-w)
    (set-v 0)
    (set-n (ldb (byte 1 (+ b-w 7)) res))
    (set-z (nullp res b-w))
    (set-c (nullp res b-w))))

;start of file importing code

(defun import-file (file)
  (setf *mem* (make-array 65536 :element-type '(unsigned-byte 8)))
  (with-open-file (in file)
    (loop for line = (read-line in nil)
       while line
       do (if (not (equal #\* (elt line 8)))
	      (let* ((split-line (split-sequence #\: line))
		     (offset (hex-string-to-int (car split-line)))
		     (blocks (subseq (split-sequence #\space (cadr split-line)) 3 11)))
		(loop for i from 0 to 7
		   for block = (elt blocks i)
		   do (set-mem (+ offset (* i 2)) (block-val block) 8)))))))

(defun block-val (str)
  (hex-string-to-int
   (concatenate 'string (subseq str 2 4) (subseq str 0 2))))

(defun reset ()
  (setf *reg* (make-array 16 :element-type '(UNSIGNED-BYTE 16)))
  (setf *mem* (make-array 65536 :element-type '(UNSIGNED-BYTE 8)))
  (setf *err* "null")
  (setf *console* "console:")
  (setf *unlocked* nil))

(defun run-level (file-name input)
  (reset)
  (setf *log-stream* (open "C:\\ben\\log.txt" :direction :output :if-exists :supersede :sharing :external))
  ;(setf *log-stream* *standard-output*)
  (print "start of run")
  (import-file file-name)
  (setf *input* input)
  (main)
  (print file-name)
  (print *console*)
  (print "error:")
  (print *err*)
  (print "unlocked?")
  (print *unlocked*))


moving BPC along

moving BPC along

/*  Copyright 2014 Aaron Boxer

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>. */

#include "ocl_platform.cl"

/*

BPC Scan Pattern

Xx4 stripes

The stripes are scanned from top to bottom, and the columns within a
stripe are scanned from left to right.

*/

#define BOUNDARY 1
#define TWICE_BOUNDARY 2
#define CODEBLOCKY_PLUS_BOUNDARY 33
#define STATE_BUFFER_SIZE 1156
#define STATE_BUFFER_STRIDE 34

#define LEFT_TOP -35
#define TOP  -34
#define RIGHT_TOP -33

#define LEFT   -1
#define RIGHT   1

#define LEFT_BOTTOM  33
#define BOTTOM  34
#define RIGHT_BOTTOM  35

// bit numbers (0 based indices)
#define INPUT_SIGN_BITPOS  15

#define NBH_BITPOS         0x2
#define RLC_BITPOS         0x4
#define PIXEL_START_BITPOS 0xA
#define PIXEL_END_BITPOS   0x18
#define SIGN_BITPOS        0x19

#define SIGMA_NEW			 0x1		  //0
#define SIGMA_OLD			 0x10		  //1
#define NBH					 0x20		  //2
#define RLC					 0x80		  //4
#define RLC_D_POSITION		 0x380        //6-9
#define PIXEL				 0x7FFF0000   //10-24
#define SIGN				 0x2000000    //25

#define INPUT_TO_SIGN_SHIFT 10

//#define AMD

CONSTANT sampler_t sampler = CLK_NORMALIZED_COORDS_FALSE  | CLK_FILTER_NEAREST;

#define BIT(pix) (((pix)>>(bp))&1)

void KERNEL run(read_only image2d_t R,
						 read_only image2d_t G,
						 read_only image2d_t B,
						 read_only image2d_t A , const unsigned int  width, const unsigned int height) {

	// Red channel

	////////////////////////////////////////////////////////////////////////////////////////
	//0.  calculate max bits

	// between one and 32 - zero value indicates that this code block is identically zero
	LOCAL int msbScratch[CODEBLOCKX];

	// state buffer
	LOCAL int state[STATE_BUFFER_SIZE];

	int2 posIn = (int2)(getLocalId(0) + getGlobalId(0)*CODEBLOCKX,  getGlobalId(1)*CODEBLOCKY);
	int maxVal = -2147483647-1;
	int index = BOUNDARY + getLocalId(0);

	state[getLocalId(0)] = 0;
	//initialize pixels, and calculate column max
	for (int i = BOUNDARY; i < CODEBLOCKY_PLUS_BOUNDARY; ++i) {
	    int pixel = read_imagei(R, sampler, posIn).x;
		state[index] = (abs(pixel) << PIXEL_START_BITPOS) | ((pixel << INPUT_TO_SIGN_SHIFT) & SIGN);
		maxVal = max(maxVal, pixel);
		index += STATE_BUFFER_STRIDE;
		posIn.y++;
	}
	state[index] = 0;

	//initialize full boundary columns
	if (getLocalId(0) == 0 || getLocalId(0) == CODEBLOCKX-1) {
	    int delta = -1 + (getLocalId(0)/(CODEBLOCKX-1))*2; // -1 or +1
		int index = BOUNDARY + getLocalId(0) + delta;
		 for (int i = 0; i < CODEBLOCKY+ TWICE_BOUNDARY; ++i) {
		     state[index] = 0;
			 index += STATE_BUFFER_STRIDE;
		 }
	}

	int maxSigBit = 31 - clz(maxVal);
	msbScratch[getLocalId(0)] =maxSigBit;
	localMemoryFence();

#ifdef AMD
	if (getLocalId(0) == 0) {
	    int4 mx = (int4)(maxSigBit);

        LOCAL int* scratchPtr = msbScratch;
		for(int i=0; i < CODEBLOCKX; i+=4) {
			mx = max(mx,(int4)(msbScratch[i],msbScratch[i+1],msbScratch[i+2],msbScratch[i+3]));
		}
		maxSigBit = mx.x;
		maxSigBit = max(maxSigBit, mx.y);
		maxSigBit = max(maxSigBit, mx.z);
		maxSigBit = max(maxSigBit, mx.w);
		msbScratch[0] = maxSigBit;
	}

	localMemoryFence();
	if (msbScratch[0] == -1)
		return;
	//////////////////////////////////////////////////////////////////////////////////////////////////////////////////

	/////////////////////////////////////////////////////////////////////////////////////////////////////////////////
	// 1. CUP on MSB

	/*
	Algorithm 13 Clean-up pass on the MSB
	1: set sigmanew := bit value
	2: set rlcNbh :=  SUM(sigmanew) of preceding column and upper position
	3: if rlcNbh = 0 and y-dimension of current position is a multiple of 4
	then
	4: execute RLC operation
	5: end if
	6: if rlcNbh = 1 then
	7: execute ZC operation
	8: end if
	9: if sigmanew = 1 then
	10: execute SC operation
	11: end if
	*/

	int bp = msbScratch[0] + PIXEL_START_BITPOS;

	//set sigma new (sigma old is zero)
	index = BOUNDARY + getLocalId(0);
	for (int i = BOUNDARY; i < CODEBLOCKY_PLUS_BOUNDARY; ++i) {
	     int val = state[index];
		 state[index] = val | BIT(val);	//set sigma new
		 index += STATE_BUFFER_STRIDE;
	}
	localMemoryFence();

	// set rlcNbh, and run CUP coding
	LOCAL int* statePtr = state + BOUNDARY + getLocalId(0);
	int y = 0;
	for (int i = BOUNDARY; i < CODEBLOCKY+BOUNDARY; ++i) {
		int current = *statePtr;
		int top = statePtr[TOP];
		int leftTop = statePtr[LEFT_TOP];
		int left = statePtr[LEFT];
		int right = statePtr[RIGHT];
		int leftBottom = statePtr[LEFT_BOTTOM];
		int nbh = BIT(top) + BIT(leftTop) + BIT(left) + BIT(leftBottom);
		nbh = ((nbh | (~nbh + 1)) >> 27) * NBH;  // NBH if non-zero, otherwise zero
		*statePtr = current | nbh;							  // set nbh

		 if (!nbh && !(y&3)) {
			//RLC
			// get information about both SIGMA_NEW and SIGMA_OLD from
			// left and right neighbours and current bit,
			// and use this to update the current RLC bit

			statePtr[0] |= (( left & SIGMA_NEW ) ||
								(left & SIGMA_OLD ) ||
								  ( current & SIGMA_NEW ) ||
								   ( current & SIGMA_OLD ) ||
								    ( right   & SIGMA_NEW ) ||
								      ( right   & SIGMA_OLD )) << RLC_BITPOS ;

			localMemoryFence();

			// get information about bit value from the left neighbour and update current RLC bit
			statePtr[0] |= BIT (statePtr[LEFT]) << RLC_BITPOS;

			localMemoryFence();

			// get the information from RLC bits of successors
			atomic_or(statePtr + (y&0xfffffffc - y)*STATE_BUFFER_STRIDE, *statePtr & RLC );

			localMemoryFence();

			int nbh = 0;

		 } else {
			//ZC

		 }
		 if (BIT(current)) {
			//SC

		 }
		 statePtr += STATE_BUFFER_STRIDE;
		 y++;

	}
	localMemoryFence();
#endif

}

/*  Copyright 2014 Aaron Boxer

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>. */

#include "ocl_platform.cl"

/*

BPC Scan Pattern

Xx4 stripes

The stripes are scanned from top to bottom, and the columns within a
stripe are scanned from left to right.

*/

#define BOUNDARY 1
#define TWICE_BOUNDARY 2
#define CODEBLOCKY_PLUS_BOUNDARY 33
#define STATE_BUFFER_SIZE 1156
#define STATE_BUFFER_STRIDE 34

#define LEFT_TOP -35
#define TOP  -34
#define RIGHT_TOP -33

#define LEFT   -1
#define RIGHT   1

#define LEFT_BOTTOM  33
#define BOTTOM  34
#define RIGHT_BOTTOM  35

// bit numbers (0 based indices)
#define INPUT_SIGN_BITPOS  15

#define NBH_BITPOS         0x2
#define RLC_BITPOS         0x4
#define PIXEL_START_BITPOS 0xA
#define PIXEL_END_BITPOS   0x18
#define SIGN_BITPOS        0x19

#define SIGMA_NEW			 0x1		  //0
#define SIGMA_OLD			 0x10		  //1
#define NBH					 0x20		  //2
#define RLC					 0x80		  //4
#define RLC_D_POSITION		 0x380        //6-9
#define PIXEL				 0x7FFF0000   //10-24
#define SIGN				 0x2000000    //25

#define INPUT_TO_SIGN_SHIFT 10

//#define AMD

CONSTANT sampler_t sampler = CLK_NORMALIZED_COORDS_FALSE  | CLK_FILTER_NEAREST;

#define CURRENT_BIT(pix) (((pix)>>(bp))&1)

void KERNEL run(read_only image2d_t R,
						 read_only image2d_t G,
						 read_only image2d_t B,
						 read_only image2d_t A , const unsigned int  width, const unsigned int height) {

	// Red channel

	////////////////////////////////////////////////////////////////////////////////////////
	//0.  calculate max bits

	// between one and 32 - zero value indicates that this code block is identically zero
	LOCAL int msbScratch[CODEBLOCKX];

	// state buffer
	LOCAL int state[STATE_BUFFER_SIZE];

	int2 posIn = (int2)(getLocalId(0) + getGlobalId(0)*CODEBLOCKX,  getGlobalId(1)*CODEBLOCKY);
	int maxVal = -2147483647-1;
	int index = BOUNDARY + getLocalId(0);

	state[getLocalId(0)] = 0;
	//initialize pixels, and calculate column max
	for (int i = BOUNDARY; i < CODEBLOCKY_PLUS_BOUNDARY; ++i) {
	    int pixel = read_imagei(R, sampler, posIn).x;
		state[index] = (abs(pixel) << PIXEL_START_BITPOS) | ((pixel << INPUT_TO_SIGN_SHIFT) & SIGN);
		maxVal = max(maxVal, pixel);
		index += STATE_BUFFER_STRIDE;
		posIn.y++;
	}
	state[index] = 0;

	//initialize full boundary columns
	if (getLocalId(0) == 0 || getLocalId(0) == CODEBLOCKX-1) {
	    int delta = -1 + (getLocalId(0)/(CODEBLOCKX-1))*2; // -1 or +1
		int index = BOUNDARY + getLocalId(0) + delta;
		 for (int i = 0; i < CODEBLOCKY+ TWICE_BOUNDARY; ++i) {
		     state[index] = 0;
			 index += STATE_BUFFER_STRIDE;
		 }
	}

	int maxSigBit = 31 - clz(maxVal);
	msbScratch[getLocalId(0)] =maxSigBit;
	localMemoryFence();

#ifdef AMD
	if (getLocalId(0) == 0) {
	    int4 mx = (int4)(maxSigBit);

        LOCAL int* scratchPtr = msbScratch;
		for(int i=0; i < CODEBLOCKX; i+=4) {
			mx = max(mx,(int4)(msbScratch[i],msbScratch[i+1],msbScratch[i+2],msbScratch[i+3]));
		}
		maxSigBit = mx.x;
		maxSigBit = max(maxSigBit, mx.y);
		maxSigBit = max(maxSigBit, mx.z);
		maxSigBit = max(maxSigBit, mx.w);
		msbScratch[0] = maxSigBit;
	}

	localMemoryFence();
	if (msbScratch[0] == -1)
		return;
	//////////////////////////////////////////////////////////////////////////////////////////////////////////////////

	/////////////////////////////////////////////////////////////////////////////////////////////////////////////////
	// 1. CUP on MSB

	/*
	Algorithm 13 Clean-up pass on the MSB
	1: set sigmanew := bit value
	2: set rlcNbh :=  SUM(sigmanew) of preceding column and upper position
	3: if rlcNbh = 0 and y-dimension of current position is a multiple of 4
	then
	4: execute RLC operation
	5: end if
	6: if rlcNbh = 1 then
	7: execute ZC operation
	8: end if
	9: if sigmanew = 1 then
	10: execute SC operation
	11: end if
	*/

	int bp = msbScratch[0] + PIXEL_START_BITPOS;

	//set sigma new
	index = BOUNDARY + getLocalId(0);
	for (int i = BOUNDARY; i < CODEBLOCKY_PLUS_BOUNDARY; ++i) {
	     int val = state[index];
		 state[index] = val | CURRENT_BIT(val);	//set sigma new
		 index += STATE_BUFFER_STRIDE;
	}
	localMemoryFence();
#else
   int bp = 11 + PIXEL_START_BITPOS;
#endif

	// set rlcNbh, and run CUP coding
	LOCAL int* statePtr = state + BOUNDARY + getLocalId(0);
	int y = 0;
	for (int i = BOUNDARY; i < CODEBLOCKY+BOUNDARY; ++i) {
		 int val = *statePtr;
		 int currentBit = CURRENT_BIT(val);

		 int top = CURRENT_BIT(statePtr[TOP]);
	     int leftTop = CURRENT_BIT(statePtr[LEFT_TOP]);
		 int left = CURRENT_BIT(statePtr[LEFT]);
		 int leftBottom = CURRENT_BIT(statePtr[LEFT_BOTTOM]);
		 int nbh = (top + leftTop + left + leftBottom);
		 nbh = ((nbh | (~nbh + 1)) >> 27) * NBH;  // NBH if non-zero, otherwise zero
		 val |= nbh;							  // set nbh

		 if (!nbh && !(y&3)) {
			//RLC

		 } else {
			//ZC

		 }
		 if (currentBit) {
			//SC

		 }
		 statePtr += STATE_BUFFER_STRIDE;
		 y++;
	}
	localMemoryFence();

}


another clean

another clean

/*
 * Accelerated k-means and mean-shift algorithms via OpenCL
 * Authors: Martin Simon & Pavel Sirucek
 *
 * OpenCL kernels
 */

/* Implementace K-means
 * Prozatim v jednom kernelu (vyhoda je ze se nemusi sznchronizovat postup zpracovani kernelu,
                              ani si nejsem jisty jak to udelat, "nevyhodou" je uzke hrdlo pri pre
							  pocitavani stredu, kdy pracuje K vlaken a ostatni cekaji, tohle se
							  vetsim poctem kernelu nevyresi, protoze by stejne vlakna musely
							  pockat na prepocitani stredu)
 * Postup zpracovani (jak by mel byt, nejsem si jisty zda to tak je):
 *
 * Kazdy pixel se priradi do clusteru (k nejblizsimu stredu).
 * Pomoci barrier() se pocka na vsechna vlakna, pote se K vlaken
 * postara o prepocitani stredu. Pocka se na vsechna prepocitani a jede se znovu.
 */
 /* TODO - velke obrazky, zpracuje se cast..problem bude nekde u maximalniho poctu vlaken nebo tak
         - artefakty u nejakych obrazku, pripadne jednou to zpracuje dobre, podruhe podivne
		 - doba zpracovani (?)
		 - zadani parametru K z cmdl, omezeni na max napr 16.
		 - doladit (nekonceny cyklus napr, detekce zmeny clsuteru apod.) (?)
 */
__kernel void kmeans(__global uchar4* input, __global uchar4* output, __global uchar4* centroids, __global uint* pixels, uint width, uint height, uint K)
{
	uint gidX = get_global_id(0);
	uint gidY = get_global_id(1);
	bool center_change = true; // detekce zmeny stredu (prepocitani)

	uint pixel_index = gidX + width * gidY;
	float min_dist; // nejmensi vzdalenost

	uint last_cluster; // minuly cluster nebo stred
	float last_dist = 0.0f; // minula vzdalenost

	while (true)
	{
		for (uint i = 0; i < K; i++)
		{
			// spocteni vzdalenosti pixelu od stredu
			float dist = 0.0f;
			float3 distxyz;
			distxyz.x = convert_float(centroids[i].x) - convert_float(input[pixel_index].x);
			distxyz.x *= distxyz.x;
			distxyz.y = convert_float(centroids[i].y) - convert_float(input[pixel_index].y);
			distxyz.y *= distxyz.y;
			distxyz.z = convert_float(centroids[i].z) - convert_float(input[pixel_index].z);
			distxyz.z *= distxyz.z;
			dist = distxyz.x + distxyz.y + distxyz.z;

			if (i == 0)
			{
				min_dist = dist;
				pixels[pixel_index] = i;
			}
			else
			{
				if (dist < min_dist)
				{ // prirazeni pixelu do noveho clusteru
					min_dist = dist;
					pixels[pixel_index] = i;
				}
			}

		}

		// konec pokud se pixel nepresunul, vzdalenost zustala stejna (tedy zadna zmena) a pokud se neprepocitavaji stredy
		if (last_cluster == pixels[pixel_index] && last_dist == min_dist && !center_change)
		{
			output[pixel_index] = centroids[pixels[pixel_index]];
			output[pixel_index].w = 255;
			return;
		}

		last_cluster = pixels[pixel_index];
		last_dist = min_dist;
		// pockame na zpracovani vsech pixelu
		barrier(CLK_GLOBAL_MEM_FENCE);

		// poslani K vlaken na clustery -> prepocitani stredu
		if (gidX < K && center_change)
		{
			// prumer hodnot
			float4 sum = {0.0f, 0.0f, 0.0f, 0.0f};
			uint num = 0;

			for (uint i = 0; i < width * height; i++)
			{
				if (pixels[i] == gidX)
				{
					sum += convert_float4(input[i]);
					num++;
				}
			}
			// novy stred
			uchar4 newCenter = convert_uchar4(sum / convert_float(num));

			if (centroids[gidX].x != newCenter.x || centroids[gidX].y != newCenter.y || centroids[gidX].z != newCenter.z)
			{
				centroids[gidX] = newCenter;
				centroids[gidX].w = 255;
			}
			else // stred se nezmenil
			{
				center_change = false;
			}
		}
		else // toto vlakno neprepocitava stredy
		{
			center_change = false;
		}

		barrier(CLK_GLOBAL_MEM_FENCE);
	}
}

__kernel void ms_begin(__global uchar4* input, __global uint* peaks, uint width, uint height, uint winsize,__global uchar4* output)
{
    int x = get_global_id(0);
    int y = get_global_id(1);
    float h = 2;

    //reconstruct window by given param
    float actx = convert_float(x);
    float acty = convert_float(y);
    int wymax = acty + ((winsize-1) / 2) + 1;
    int wymin = acty - ((winsize-1) / 2);
    int wxmax = actx + ((winsize-1) / 2) + 1;
    int wxmin = actx - ((winsize-1) / 2);

    float oldx = convert_float(x);
    float oldy = convert_float(y);

    //mean-shift
    float numX, numY, den;
    float ecko;
    float hinv = 1/h;

    //cycle control value
    bool cont = true;
    int iter = 0;
    //mean structures
    //float newX, newY;

    //begincycle - until the step is bigger than relevant
    do {
        //newX = 0;
        //newY = 0;

        numX = numY = den =0;

        for (int wy = wymin; wy < wymax; wy++)
        {
            for (int wx = wxmin; wx < wxmax; wx++)
            {
                if (wx < 0 || wy < 0 || wx >= width|| wy >= height)
                {
                    //out of original window
                    continue;
                }
                else
                {
                    //compute lengths for [wx,wy] - [x,y]
                    int gid = convert_int_rte(actx) + convert_int_rte(acty)*width;

                    float normalXDiff = actx/(width-1) - wx/(width-1);
                    float normalYDiff = acty/(height-1) - wy/(height-1);
                    float normalRDiff = convert_float(input[gid].s0)/255 - convert_float(input[wx + wy*width].s0)/255;
                    float normalGDiff = convert_float(input[gid].s1)/255 - convert_float(input[wx + wy*width].s1)/255;
                    float normalBDiff = convert_float(input[gid].s2)/255 - convert_float(input[wx + wy*width].s2)/255;

                    /* ||act - w||^2 */
                    float length =
                        normalXDiff * normalXDiff +
                        normalYDiff * normalYDiff +
                        normalRDiff * normalRDiff +
                        normalGDiff * normalGDiff +
                        normalBDiff * normalBDiff;

                    /* e^((-length)/h) */
                    ecko = exp(-hinv * length);

                    /* sum of X coordinate - numerator */
                    numX += wx * ecko;

                    /* sum of Y coordinate - numerator */
                    numY += wy * ecko;

                    /* sum of denominator */
                    den += ecko;
                }
            }
        }

        //recompute mean of the window
        oldx = actx;
        oldy = acty;

        actx = numX/den;
        acty = numY/den;

//printf("[%d:%d](%d)- old:[%f,%f], new diff:[%f,%f]\n", x,y,iter,oldx,oldy,actx,acty);

        //shift the window to the mean be in the center
        wymax = convert_int_rte(acty) + ((winsize-1) / 2) + 1;
        wymin = convert_int_rte(acty) - ((winsize-1) / 2);
        wxmax = convert_int_rte(actx) + ((winsize-1) / 2) + 1;
        wxmin = convert_int_rte(actx) - ((winsize-1) / 2);

        if(fabs(oldx - actx) <= 0.1 && fabs(oldy - acty) <= 0.1)
        {
            //the step is lower the 0.5pix
            cont = false;
        }

        //endcycle
        iter++;
    } while (cont && iter < 1000);

    actx = convert_float(max(convert_int_rte(actx),0));
    acty = convert_float(max(convert_int_rte(acty),0));

    actx = convert_float(min(convert_int_rte(actx),convert_int_rte(width)-1));
    acty = convert_float(min(convert_int_rte(acty),convert_int_rte(height)-1));

    //store the peak position to peaks array
    peaks[x + y*width] = convert_int_rte(actx) + convert_int_rte(acty)*width;

    //set result color
    output[x + y*width] = input[peaks[x + y*width]];
}

__kernel void ms_optimize(__global uint* peaks, uint width)
{
//    int gid = get_global_id(0) + width * get_global_id(1);
//
//    int peak = peaks[gid];
//
//    for (int i=0; i<100;i++)
//    {
//        if(peaks[peaks[peak]] == peaks[peak])
//        {
//            break;
//        }
//        printf("neco");
//        peaks[gid] = peaks[peak];
//        peak = peaks[peaks[peak]];
//    }
}

__kernel void ms_color(__global uchar4* output, __global uchar* colors, __global uint* peaks, uint width)
{
    int gid = get_global_id(0) + width * get_global_id(1);

    output[gid] = colors[peaks[gid]];
}


minor

minor

/*
 * Copyright (c) 2016 AMD Inc.
 *
 * Permission is hereby granted, free of charge, to any person obtaining a
 * copy of this software and/or associated documentation files (the
 * "Materials"), to deal in the Materials without restriction, including
 * without limitation the rights to use, copy, modify, merge, publish,
 * distribute, sublicense, and/or sell copies of the Materials, and to
 * permit persons to whom the Materials are furnished to do so, subject to
 * the following conditions:
 *
 * The above copyright notice and this permission notice shall be included
 * in all copies or substantial portions of the Materials.
 *
 * THE MATERIALS ARE PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
 * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
 * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
 * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
 * CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
 * TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 * MATERIALS OR THE USE OR OTHER DEALINGS IN THE MATERIALS.
 */

#define _FLOAT					float
#define _FLOAT2					float2
#define _FLOAT4					float4
#define _FLOAT8					float8

#ifndef FLT_MAX
#define FLT_MAX         3.402823466e+38F        /* max value */
#endif

#define MLO_N_OUT_HORIZ_READS ((MLO_OUT_WIDTH + MLO_IN_TILE0 - 1) / MLO_IN_TILE0)
#define MLO_N_SPANS_PER_SCAN (MLO_N_OUT_HORIZ_READS)
#define MLO_N_OUT_HORIZ_PIX_READS (MLO_PER_WAVE_READ * MLO_IN_TILE0)
#define MLO_N_OUT_VERTICAL_READS (MLO_FILTER_SIZE1)

#define MLO_IN_VERT_READS (MLO_IN_HEIGHT)
// there is an assumption that the scanline fits into LDS
#define MLO_N_IN_HORIZ_PIX_READS (MLO_IN_WIDTH)
#define MLO_N_IN_HORIZ_READS ((MLO_N_IN_HORIZ_PIX_READS + MLO_READ_UNIT - 1) / MLO_READ_UNIT)
#define MLO_IN_N_PIXS_OFF  (MLO_N_IN_HORIZ_READS*MLO_READ_UNIT - MLO_N_IN_HORIZ_PIX_READS)
#define MLO_IN_LCL_WIDTH (MLO_N_IN_HORIZ_READS * MLO_READ_UNIT + 2* MLO_FILTER_PAD0)
#define MLO_IN_LCL_HEIGHT MLO_IN_VERT_READS
#define MLO_IN_LCL_SZ (MLO_IN_LCL_WIDTH * MLO_IN_LCL_HEIGHT)
#define MLO_TOTAL_IN_LCL_SZ (MLO_N_LCL_BATCHS*MLO_N_LCL_IN_MAPS*MLO_IN_LCL_SZ)

#define MLO_WEI_LCL_SZ (MLO_GRP_SZ * MLO_FILTER_SIZE0)
#if MLO_TOTAL_IN_LCL_SZ > MLO_WEI_LCL_SZ
#define MLO_LCL_SZ (MLO_TOTAL_IN_LCL_SZ)
#else
#define MLO_LCL_SZ (MLO_WEI_LCL_SZ)
#endif

#define MLO_HW_WAVE_ID_SETTING 0

#if MLO_HW_WAVE_ID_SETTING
extern __attribute__((const)) uint __hsail_get_dynwave_id(void);
inline int getWaveId()
{
	int wave_id = 0;

	wave_id = __hsail_get_dynwave_id();
	wave_id = wave_id & MLO_N_PHYS_WAVES_MASK;
	return(wave_id);
}
#else
inline int getWaveId()
{
	int wave_id = 0;

	wave_id = (get_local_id(0) >> MLO_LG2_PHYS_WAVE_SZ);

	return(wave_id);
}
#endif

inline int gePhysLocalId()
{
	int lcl_wave_id = get_local_id(0) - ((get_local_id(0) >> MLO_LG2_PHYS_WAVE_SZ) << MLO_LG2_PHYS_WAVE_SZ);
	return(lcl_wave_id);
}

inline int iDiv(int v, int d)
{
	int r = (int)((float)v / d + 0.00001f);
	return(r);
}

inline int iMod(int v, int u, int d)
{
	int r = v - mul24((int)u, (int)d);
	return(r);
}

inline void ReduceKernel(__local _FLOAT * lcl_blob, _FLOAT *weights_accum, int lcl_id, int scan_lcl, int sum_stride, int unit_len, bool debug)
{
// read first half
	if (scan_lcl < (sum_stride >> 1))
	{
		for (int i = 0; i < unit_len; ++i)
		{
			weights_accum[i] = lcl_blob[(lcl_id + scan_lcl) * unit_len + i];

		}

	}
// add second half
// appload accumulated value so far
	for (int j = (sum_stride >> 1); j > 0; j >>= 1)
	{
		barrier(CLK_LOCAL_MEM_FENCE);
		if (scan_lcl < j)
		{
			for (int i = 0; i < unit_len; ++i)
			{
				weights_accum[i] += lcl_blob[(lcl_id + j) * unit_len + i];

				lcl_blob[lcl_id * unit_len + i] = weights_accum[i];
			}

		}
	}
}

inline void ReduceKernel64(__local _FLOAT * lcl_blob, _FLOAT *weights_accum, int lcl_id, int scan_lcl, int sum_stride, int unit_len, bool debug)
{
	// read first half
	if (scan_lcl < (sum_stride >> 1))
	{
		for (int i = 0; i < unit_len; ++i)
		{
			weights_accum[i] = lcl_blob[(lcl_id + scan_lcl) * unit_len + i];

		}

	}
	// add second half
	// appload accumulated value so far
	for (int j = (sum_stride >> 1); j > 0; j >>= 1)
	{
		barrier(CLK_LOCAL_MEM_FENCE);
		if (scan_lcl < j)
		{
			for (int i = 0; i < unit_len; ++i)
			{
				weights_accum[i] += lcl_blob[(lcl_id + j) * unit_len + i];

				lcl_blob[lcl_id * unit_len + i] = weights_accum[i];
			}

		}
	}
}

inline void  Kahan_summation(_FLOAT *sum, _FLOAT * c, _FLOAT v)
{
	_FLOAT y = v - *c;    //So far, so good: c is zero.
	_FLOAT t = *sum + y;         //Alas, sum is big, y small, so low-order digits of y are lost.
	*c = (t - *sum) - y;   //(t - sum) recovers the high-order part of y; subtracting y recovers -(low part of y)
	*sum = t;             //Algebraically, c should always be zero. Beware eagerly optimising compilers!
}

inline void  Kahan_summation_tricked(_FLOAT *sum, _FLOAT * c, _FLOAT v, _FLOAT mod)
{
	_FLOAT y = v - *c;    //So far, so good: c is zero.
	_FLOAT t = *sum + y;         //Alas, sum is big, y small, so low-order digits of y are lost.
	*c = (t - *sum) * mod - y;   //(t - sum) recovers the high-order part of y; subtracting y recovers -(low part of y)
	*sum = t;             //Algebraically, c should always be zero. Beware eagerly optimising compilers!
}

inline void Kahan_summation2(_FLOAT *sum, _FLOAT *c, _FLOAT *v, int n)
{
	for (int i = 0; i < n; ++i)
	{
		_FLOAT y = v[i] - c[i];    //So far, so good: c is zero.
		_FLOAT t = sum[i] + y;         //Alas, sum is big, y small, so low-order digits of y are lost.
		c[i] = (t - sum[i]) - y;   //(t - sum) recovers the high-order part of y; subtracting y recovers -(low part of y)
		sum[i] = t;             //Algebraically, c should always be zero. Beware eagerly optimising compilers!
	}
}

inline void readInput(int lcl_id, int gbl_in_scan_off, const __global _FLOAT * bot, __local _FLOAT *lcl_bot)
{
	for (int p4 = lcl_id; p4 < MLO_N_LCL_IN_MAPS * MLO_N_IN_HORIZ_READS * MLO_IN_VERT_READS;
		p4 += MLO_GRP_SZ)
	{
		__private _FLOAT in_rd_data[MLO_READ_UNIT];
// TODO : more than 1 input
		int c = 0;
		int c_scan = iDiv(p4, (MLO_N_IN_HORIZ_READS));

		int c_pix4 = iMod(p4, c_scan, (MLO_N_IN_HORIZ_READS));

//		if (c < MLO_N_INPUTS)

		{

#if MLO_IN_N_PIXS_OFF > 0

			if (c_pix4 == MLO_N_IN_HORIZ_READS - 1)
			{
				for (int i = 0; i < MLO_IN_N_PIXS_OFF; ++i)
				{

					in_rd_data[i] = bot[gbl_in_scan_off + c*MLO_IN_CHANNEL_STRIDE + c_scan* MLO_IN_STRIDE + c_pix4*MLO_READ_UNIT + i];
				}

				for (int i = MLO_READ_UNIT - 1; i >= MLO_READ_UNIT - MLO_IN_N_PIXS_OFF; --i)
				{
					in_rd_data[i] = 0;
				}

			}
			else
#endif
			{
				*(MLO_READ_TYPE*)in_rd_data = *(MLO_READ_TYPE*)&bot[gbl_in_scan_off + c*MLO_IN_CHANNEL_STRIDE + c_scan* MLO_IN_STRIDE + c_pix4*MLO_READ_UNIT];
			}

// stack of inputs, each has 1 line
			for (int i = 0; i < MLO_READ_UNIT; ++i)
			{
				int lcl_in_off = c*MLO_IN_LCL_SZ + c_scan* MLO_IN_LCL_WIDTH + MLO_FILTER_PAD0 + c_pix4*MLO_READ_UNIT + i;
				lcl_bot[lcl_in_off] = in_rd_data[i];
#if 0
				if (c == 0 && c_scan ==1 && c_pix4 == 0)
				{
					printf("K:g: %d %d %d %d %f\n",
						lcl_id,
						c_scan,
						i,
						lcl_in_off,
						lcl_bot[lcl_in_off]
					);
				}
#endif
			}
		}

	} // for (int p4 = lcl_id; p4 < MLO_N_LCL_IN_MAPS * MLO_N_IN_HORIZ_READS * MLO_IN_VERT_READS;

	barrier(CLK_LOCAL_MEM_FENCE);

}

inline void Processing(int sc, int sc_lcl_off, int top_lim, int bot_lim, __private _FLOAT * pvt_accum, __local _FLOAT * lcl_bot, __private _FLOAT * top_dat)
{
	for (int l = top_lim; l >= bot_lim; --l)
	{
		for (int m = 0; m < MLO_IN_TILE0; ++m)
		{
			for (int n = 0; n < MLO_FILTER_SIZE0; ++n)
			{
				_FLOAT bot_val = lcl_bot[sc_lcl_off + n + m];
				_FLOAT top_val = top_dat[(top_lim - l) * MLO_IN_TILE0 + m];
				pvt_accum[l*MLO_FILTER_SIZE0 + n]
					// each wk-item process an input
					+= bot_val * top_val;
#if 0
				if (/*bot_val * top_val != 0 && */get_global_id(1) == 0 && get_global_id(2) == 0 && get_local_id(0) == 0 && l == 2 && n == 0)
				{
					printf("G: %d %d  %f %f %f %f\n",
						sc,
						sc_lcl_off,
						pvt_accum[l*MLO_FILTER_SIZE0 + n],
						bot_val * top_val,
						bot_val,
						top_val
					);
				}
#endif

			}

		}

	}

}
/*********************************************************************************************************
// wrw algorithm for large filters
// idea:
// split output line line on number of spans by number of waves
// read MLO_FILTER_SIZE1 number of such spans into SGPS (for example 5 *7 = 35)
// read 1 input line for 64 maps into LDS
//
// alg
//
// accumulate 1 scan of data per wave per each input map per wk-item

**********************************************************************************************************/

__attribute__((reqd_work_group_size(MLO_GRP_SZ0, MLO_GRP_SZ1, MLO_GRP_SZ2)))
__kernel void MLOpenCvBwdWrW(
	const __global _FLOAT * top_df,
	const __global _FLOAT * bot,
	__global _FLOAT * weights_df,
#if MLO_CONV_BIAS
	__global _FLOAT * bias_df,
#endif
	_FLOAT padding_val
)
{

	// input/output tiles + reduce buffer

	__local _FLOAT lcl[(MLO_LCL_SZ)];
	__local _FLOAT * lcl_bot = lcl;

	// guarnteeing an uniformity over a wave
	int wave_id = getWaveId();
	int lcl_id = get_local_id(0);
	int lcl_wv_id = gePhysLocalId();

	int c_idx_base = get_group_id(1); // input map index base

	int o_idx_base = iDiv(get_group_id(2), (MLO_BATCH_SZ / (MLO_N_BATCH_LOOPS*MLO_N_LCL_BATCHS))); // output map index base
	int ib_base = iMod(get_group_id(2), o_idx_base, (MLO_BATCH_SZ / (MLO_N_BATCH_LOOPS*MLO_N_LCL_BATCHS)));

	int ib = ib_base*MLO_N_LCL_BATCHS;

	int c_idx = c_idx_base * MLO_N_LCL_IN_MAPS; // input map index

	int o_idx = o_idx_base * (MLO_N_LCL_OUT_MAPS * MLO_OUT_STACKS); // output map index

	int gbl_in_off = c_idx * MLO_IN_CHANNEL_STRIDE + ib * MLO_IN_BATCH_STRIDE;
	int gbl_out_off = o_idx * MLO_OUT_CHANNEL_STRIDE + ib * MLO_OUT_BATCH_STRIDE;
// 1 span per wk_item, total scanline with MLO_N_SPANS_PER_SCAN spans
// TODO: more than 1 input
	int o = iDiv(lcl_id, MLO_N_SPANS_PER_SCAN);
	bool scan_lead = (o*MLO_N_SPANS_PER_SCAN == lcl_id);
	int spn = iMod(lcl_id, o, MLO_N_SPANS_PER_SCAN);
#define MLO_TOP_DAT_SZ (MLO_IN_TILE0 * MLO_FILTER_SIZE1)
	int lcl_bot_off = spn * MLO_IN_TILE0;
	int out_wk_item_off = o * MLO_OUT_CHANNEL_STRIDE + lcl_bot_off;
	gbl_out_off += out_wk_item_off;

	__private _FLOAT top_dat[MLO_TOP_DAT_SZ];

	for (int i = 0; i < MLO_TOP_DAT_SZ; ++i)
	{
		top_dat[i] = 0;
	}

#define MLO_ACCUM_SZ (MLO_FILTER_SIZE1*MLO_FILTER_SIZE0)

	__private _FLOAT pvt_accum[MLO_ACCUM_SZ];

	for (int i = 0; i < MLO_ACCUM_SZ; ++i)
	{
		pvt_accum[i] = 0;
	}

	// zero out LDS
	for (int i = lcl_id; i < (MLO_LCL_SZ); i += MLO_GRP_SZ)
	{
		lcl[i] = 0;
	}

//	barrier(CLK_LOCAL_MEM_FENCE);

	// over all batches

	for (int b = 0;
		b < MLO_N_BATCH_LOOPS;
		++b,
		gbl_in_off += MLO_N_LCL_BATCHS*MLO_IN_BATCH_STRIDE,
		gbl_out_off += MLO_N_LCL_BATCHS*MLO_OUT_BATCH_STRIDE
		)
	{
		int in_y = 0;
	//	int out_y = 0;

		int gbl_in_scan_off = gbl_in_off;
		int gbl_out_scan_off = gbl_out_off;
		// over all out blocks
		// processing per MLO_N_ALIGNED_OUT_SCAN_BLK output scans

		// read input line
		readInput(lcl_id, gbl_in_scan_off, bot, lcl_bot);

		// prefetch output
		for (int j = 0; j < MLO_FILTER_SIZE1 - 1; ++j)
		{
			int top_df_off = gbl_out_scan_off;
			_FLOAT mask = 1;
#if MLO_FILTER_SIZE1 - 1 > MLO_OUT_HEIGHT
			top_df_off = (j < MLO_OUT_HEIGHT) ? top_df_off : 0;
			mask = (j < MLO_OUT_HEIGHT) ? 1 : 0;
#endif
			for (int i = 0; i < MLO_IN_TILE0; ++i)
			{
				_FLOAT top_val = top_df[top_df_off + j * MLO_OUT_STRIDE + i] * mask;
				top_dat[j*MLO_IN_TILE0 + i] = top_val;
			}
		}

		barrier(CLK_LOCAL_MEM_FENCE);

		// prolog
		// handling padding

		int sc = 0;
		int sc_lcl_off = lcl_bot_off;
// pad0

// processing
		Processing(sc, sc_lcl_off, MLO_FILTER_PAD1, 0, pvt_accum, lcl_bot, top_dat);
		gbl_out_scan_off += MLO_OUT_STRIDE;
		sc++;
		sc_lcl_off += MLO_IN_LCL_WIDTH;

// pad1
		Processing(sc, sc_lcl_off, MLO_FILTER_PAD1 + 1, 0, pvt_accum, lcl_bot, top_dat);
		gbl_out_scan_off += MLO_OUT_STRIDE;
		sc++;
		sc_lcl_off += MLO_IN_LCL_WIDTH;

// generic

		for (; sc < MLO_OUT_HEIGHT - MLO_FILTER_PAD1 - (MLO_FILTER_SIZE1 - 2 - MLO_FILTER_PAD1); ++sc, gbl_out_scan_off += MLO_OUT_STRIDE, sc_lcl_off += MLO_IN_LCL_WIDTH)
		{

			int top_df_off = gbl_out_scan_off;
			_FLOAT mask = 1;

#if MLO_FILTER_SIZE1 > MLO_OUT_HEIGHT
			top_df_off = ((sc + MLO_FILTER_SIZE1 - 2) < MLO_OUT_HEIGHT) ? top_df_off : 0;
			mask = ((sc + MLO_FILTER_SIZE1 - 2) < MLO_OUT_HEIGHT) ? 1 : 0;
#endif
			// move in the last output scans
			// !!!! 2 is seleted because compiler cannot handle register allocation properly
			for (int j = 2; j < MLO_FILTER_SIZE1; ++j)
			{
				for (int i = 0; i < MLO_IN_TILE0; ++i)
				{
					top_dat[j *MLO_IN_TILE0 + i] = top_df[top_df_off + (j-2) * MLO_OUT_STRIDE + i] * mask;
				}

			}

			  // processing
			Processing(sc, sc_lcl_off, MLO_FILTER_SIZE1 - 1, 0, pvt_accum, lcl_bot, top_dat);
// move up output
// !!!! 2 is seleted because compiler cannot handle register allocation properly
			for (int j = 0; j < 2/*MLO_FILTER_SIZE1 - 1*/; ++j)
			{
				for (int i = 0; i < MLO_IN_TILE0; ++i)
				{
					top_dat[j*MLO_IN_TILE0 + i] = top_dat[(j+1)*MLO_IN_TILE0 + i];
				}
			}

		}

#if 0
		{
			int top_df_off = gbl_out_scan_off;
			_FLOAT mask = 1;

#if MLO_FILTER_SIZE1 > MLO_OUT_HEIGHT
			top_df_off = ((sc + MLO_FILTER_SIZE1 - 2) < MLO_OUT_HEIGHT) ? top_df_off : 0;
			mask = ((sc + MLO_FILTER_SIZE1 - 2) < MLO_OUT_HEIGHT) ? 1 : 0;
#endif
			// move in the last output scans
			// !!!! 2 is seleted because compiler cannot handle register allocation properly
			for (int j = 2; j < MLO_FILTER_SIZE1 - 1; ++j)
			{
				for (int i = 0; i < MLO_IN_TILE0; ++i)
				{
					top_dat[j *MLO_IN_TILE0 + i] = top_df[top_df_off + (j - 2) * MLO_OUT_STRIDE + i] * mask;
				}

			}
		}
#endif
// epilog
// handling padding
// pad1
//		for (; sc < MLO_OUT_HEIGHT - MLO_FILTER_PAD1 + 1; ++sc, sc_lcl_off += MLO_IN_LCL_WIDTH)
		{

			  // processing
			Processing(sc, sc_lcl_off, MLO_FILTER_SIZE1 - 1, MLO_FILTER_PAD1 - 1, pvt_accum, lcl_bot, top_dat);
			  // move up output
			for (int j = 0; j < MLO_FILTER_SIZE1 - 2; ++j)
			{
				for (int i = 0; i < MLO_IN_TILE0; ++i)
				{
					top_dat[j*MLO_IN_TILE0 + i] = top_dat[(j + 1)*MLO_IN_TILE0 + i];
				}
			}

		} // for (; sc < MLO_OUT_HEIGHT - MLO_FILTER_PAD1 + 1; ++sc, gbl_out_scan_off += MLO_OUT_CHANNEL_STRIDE, gbl_in_scan_off += MLO_IN_CHANNEL_STRIDE)
		++sc;
		sc_lcl_off += MLO_IN_LCL_WIDTH;

// pad0
//		for (; sc < MLO_OUT_HEIGHT; ++sc, , sc_lcl_off += MLO_IN_LCL_WIDTH)
		{
			// processing
			Processing(sc, sc_lcl_off, MLO_FILTER_SIZE1 - 1, MLO_FILTER_PAD1, pvt_accum, lcl_bot, top_dat);
		} // for (; sc < MLO_OUT_HEIGHT - MLO_FILTER_PAD1 + 2; ++sc, gbl_out_scan_off += MLO_OUT_CHANNEL_STRIDE, gbl_in_scan_off += MLO_IN_CHANNEL_STRIDE)

	} // 	for (int b = 0;

// final summation
	for (int l = 0; l < MLO_FILTER_SIZE1; ++l)
	{
		for (int n = 0; n < MLO_FILTER_SIZE0; ++n)
		{
			lcl[lcl_id * MLO_FILTER_SIZE0 + n] =
				pvt_accum[l*MLO_FILTER_SIZE0 + n];
#if 0
			if (lcl_wv_id == 0 && l == 2 && n == 3)
			{
				printf("G:s1: %f\n",
					pvt_accum[l*MLO_FILTER_SIZE0 + n]
				);
			}
#endif

		}

		barrier(CLK_LOCAL_MEM_FENCE);

		if (scan_lead)
		{
			for (int s = 0; s < MLO_N_SPANS_PER_SCAN - 1; ++s)
			{

				for (int n = 0; n < MLO_FILTER_SIZE0; ++n)
				{
					pvt_accum[l*MLO_FILTER_SIZE0 + n]
						+= lcl[(lcl_id + s + 1) * MLO_FILTER_SIZE0 + n];
#if 0
					if (lcl_wv_id == 0 && l == 2 && n == 3)
					{
						printf("G:s2: %f %f\n",
							pvt_accum[l*MLO_FILTER_SIZE0 + n],
							lcl[(w* MLO_HW_WAVE_SZ + lcl_wv_id) * MLO_FILTER_SIZE0 + n]
						);
					}
#endif

				}

			}
		}

		barrier(CLK_LOCAL_MEM_FENCE);
	}

// output
// inputs are outputs
// TODO : for more than 1 input
	int c = 0;

	int wei_df_off = ((ib * MLO_N_OUTPUTS + o_idx + o) * (int)MLO_WEI_BATCH_STRIDE)
		// this input channel
		+ mul24((c_idx + c), (int)MLO_WEI_CHANNEL_STRIDE);
	if (scan_lead && o_idx + o < MLO_N_OUTPUTS)
	{
		for (int i = 0; i < (MLO_FILTER_SIZE1 * MLO_FILTER_SIZE0); ++i)
		{
			weights_df[wei_df_off + i] = pvt_accum[i];
		}

	}

}

// final reduction kernel
// add filters over batches
__attribute__((reqd_work_group_size(MLO_UT_GRP_SZ0, 1, 1)))
__kernel void MLOpenCvBwdWrW_rdc(
	const __global _FLOAT * weight_df_tmp,
	__global _FLOAT * weights_df
)
{
	int gbl_id = get_global_id(0);
	int wei_idx0 = gbl_id * MLO_UT_READ_UNIT;

	int wei_blk_idx = iDiv(wei_idx0, MLO_WEI_CHANNEL_STRIDE);
	int wei_idx = iMod(wei_idx0, wei_blk_idx, MLO_WEI_CHANNEL_STRIDE);

	_FLOAT pvt_accum_wei[MLO_UT_READ_UNIT];
	for (int i = 0; i < MLO_UT_READ_UNIT; ++i)
	{
		pvt_accum_wei[i] = 0;
	}

	int batch_loop = (MLO_BATCH_SZ + (MLO_N_BATCH_LOOPS*MLO_N_LCL_BATCHS) - 1) / (MLO_N_BATCH_LOOPS*MLO_N_LCL_BATCHS);
	for (int i = 0; i < batch_loop; ++i)
	{
		*(MLO_UT_READ_TYPE*)pvt_accum_wei
			+= *(MLO_UT_READ_TYPE*)&weight_df_tmp[(wei_blk_idx * MLO_WEI_CHANNEL_STRIDE + i* MLO_N_OUTPUTS*MLO_WEI_BATCH_STRIDE)  + wei_idx];
	}

	*(MLO_UT_READ_TYPE*)&weights_df[wei_idx0] = *(MLO_UT_READ_TYPE*)pvt_accum_wei;

}

/*
 * Copyright (c) 2016 AMD Inc.
 *
 * Permission is hereby granted, free of charge, to any person obtaining a
 * copy of this software and/or associated documentation files (the
 * "Materials"), to deal in the Materials without restriction, including
 * without limitation the rights to use, copy, modify, merge, publish,
 * distribute, sublicense, and/or sell copies of the Materials, and to
 * permit persons to whom the Materials are furnished to do so, subject to
 * the following conditions:
 *
 * The above copyright notice and this permission notice shall be included
 * in all copies or substantial portions of the Materials.
 *
 * THE MATERIALS ARE PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
 * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
 * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
 * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
 * CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
 * TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 * MATERIALS OR THE USE OR OTHER DEALINGS IN THE MATERIALS.
 */

#define _FLOAT					float
#define _FLOAT2					float2
#define _FLOAT4					float4
#define _FLOAT8					float8

#ifndef FLT_MAX
#define FLT_MAX         3.402823466e+38F        /* max value */
#endif

#define MLO_N_OUT_HORIZ_READS ((MLO_OUT_WIDTH + MLO_IN_TILE0 - 1) / MLO_IN_TILE0)
#define MLO_N_SPANS_PER_SCAN (MLO_N_OUT_HORIZ_READS)
#define MLO_N_OUT_HORIZ_PIX_READS (MLO_PER_WAVE_READ * MLO_IN_TILE0)
#define MLO_N_OUT_VERTICAL_READS (MLO_FILTER_SIZE1)

#define MLO_IN_VERT_READS (MLO_IN_HEIGHT)
// there is an assumption that the scanline fits into LDS
#define MLO_N_IN_HORIZ_PIX_READS (MLO_IN_WIDTH)
#define MLO_N_IN_HORIZ_READS ((MLO_N_IN_HORIZ_PIX_READS + MLO_READ_UNIT - 1) / MLO_READ_UNIT)
#define MLO_IN_N_PIXS_OFF  (MLO_N_IN_HORIZ_READS*MLO_READ_UNIT - MLO_N_IN_HORIZ_PIX_READS)
#define MLO_IN_LCL_WIDTH (MLO_N_IN_HORIZ_READS * MLO_READ_UNIT + 2* MLO_FILTER_PAD0)
#define MLO_IN_LCL_HEIGHT MLO_IN_VERT_READS
#define MLO_IN_LCL_SZ (MLO_IN_LCL_WIDTH * MLO_IN_LCL_HEIGHT)
#define MLO_TOTAL_IN_LCL_SZ (MLO_N_LCL_BATCHS*MLO_N_LCL_IN_MAPS*MLO_IN_LCL_SZ)

#define MLO_WEI_LCL_SZ (MLO_GRP_SZ * MLO_FILTER_SIZE0)
#if MLO_TOTAL_IN_LCL_SZ > MLO_WEI_LCL_SZ
#define MLO_LCL_SZ (MLO_TOTAL_IN_LCL_SZ)
#else
#define MLO_LCL_SZ (MLO_WEI_LCL_SZ)
#endif

#define MLO_HW_WAVE_ID_SETTING 0

#if MLO_HW_WAVE_ID_SETTING
extern __attribute__((const)) uint __hsail_get_dynwave_id(void);
inline int getWaveId()
{
	int wave_id = 0;

	wave_id = __hsail_get_dynwave_id();
	wave_id = wave_id & MLO_N_PHYS_WAVES_MASK;
	return(wave_id);
}
#else
inline int getWaveId()
{
	int wave_id = 0;

	wave_id = (get_local_id(0) >> MLO_LG2_PHYS_WAVE_SZ);

	return(wave_id);
}
#endif

inline int gePhysLocalId()
{
	int lcl_wave_id = get_local_id(0) - ((get_local_id(0) >> MLO_LG2_PHYS_WAVE_SZ) << MLO_LG2_PHYS_WAVE_SZ);
	return(lcl_wave_id);
}

inline int iDiv(int v, int d)
{
	int r = (int)((float)v / d + 0.00001f);
	return(r);
}

inline int iMod(int v, int u, int d)
{
	int r = v - mul24((int)u, (int)d);
	return(r);
}

inline void ReduceKernel(__local _FLOAT * lcl_blob, _FLOAT *weights_accum, int lcl_id, int scan_lcl, int sum_stride, int unit_len, bool debug)
{
// read first half
	if (scan_lcl < (sum_stride >> 1))
	{
		for (int i = 0; i < unit_len; ++i)
		{
			weights_accum[i] = lcl_blob[(lcl_id + scan_lcl) * unit_len + i];

		}

	}
// add second half
// appload accumulated value so far
	for (int j = (sum_stride >> 1); j > 0; j >>= 1)
	{
		barrier(CLK_LOCAL_MEM_FENCE);
		if (scan_lcl < j)
		{
			for (int i = 0; i < unit_len; ++i)
			{
				weights_accum[i] += lcl_blob[(lcl_id + j) * unit_len + i];

				lcl_blob[lcl_id * unit_len + i] = weights_accum[i];
			}

		}
	}
}

inline void ReduceKernel64(__local _FLOAT * lcl_blob, _FLOAT *weights_accum, int lcl_id, int scan_lcl, int sum_stride, int unit_len, bool debug)
{
	// read first half
	if (scan_lcl < (sum_stride >> 1))
	{
		for (int i = 0; i < unit_len; ++i)
		{
			weights_accum[i] = lcl_blob[(lcl_id + scan_lcl) * unit_len + i];

		}

	}
	// add second half
	// appload accumulated value so far
	for (int j = (sum_stride >> 1); j > 0; j >>= 1)
	{
		barrier(CLK_LOCAL_MEM_FENCE);
		if (scan_lcl < j)
		{
			for (int i = 0; i < unit_len; ++i)
			{
				weights_accum[i] += lcl_blob[(lcl_id + j) * unit_len + i];

				lcl_blob[lcl_id * unit_len + i] = weights_accum[i];
			}

		}
	}
}

inline void  Kahan_summation(_FLOAT *sum, _FLOAT * c, _FLOAT v)
{
	_FLOAT y = v - *c;    //So far, so good: c is zero.
	_FLOAT t = *sum + y;         //Alas, sum is big, y small, so low-order digits of y are lost.
	*c = (t - *sum) - y;   //(t - sum) recovers the high-order part of y; subtracting y recovers -(low part of y)
	*sum = t;             //Algebraically, c should always be zero. Beware eagerly optimising compilers!
}

inline void  Kahan_summation_tricked(_FLOAT *sum, _FLOAT * c, _FLOAT v, _FLOAT mod)
{
	_FLOAT y = v - *c;    //So far, so good: c is zero.
	_FLOAT t = *sum + y;         //Alas, sum is big, y small, so low-order digits of y are lost.
	*c = (t - *sum) * mod - y;   //(t - sum) recovers the high-order part of y; subtracting y recovers -(low part of y)
	*sum = t;             //Algebraically, c should always be zero. Beware eagerly optimising compilers!
}

inline void Kahan_summation2(_FLOAT *sum, _FLOAT *c, _FLOAT *v, int n)
{
	for (int i = 0; i < n; ++i)
	{
		_FLOAT y = v[i] - c[i];    //So far, so good: c is zero.
		_FLOAT t = sum[i] + y;         //Alas, sum is big, y small, so low-order digits of y are lost.
		c[i] = (t - sum[i]) - y;   //(t - sum) recovers the high-order part of y; subtracting y recovers -(low part of y)
		sum[i] = t;             //Algebraically, c should always be zero. Beware eagerly optimising compilers!
	}
}

inline void readInput(int lcl_id, int gbl_in_scan_off, const __global _FLOAT * bot, __local _FLOAT *lcl_bot)
{
	for (int p4 = lcl_id; p4 < MLO_N_LCL_IN_MAPS * MLO_N_IN_HORIZ_READS * MLO_IN_VERT_READS;
		p4 += MLO_GRP_SZ)
	{
		__private _FLOAT in_rd_data[MLO_READ_UNIT];
// TODO : more than 1 input
		int c = 0;
		int c_scan = iDiv(p4, (MLO_N_IN_HORIZ_READS));

		int c_pix4 = iMod(p4, c_scan, (MLO_N_IN_HORIZ_READS));

//		if (c < MLO_N_INPUTS)

		{

#if MLO_IN_N_PIXS_OFF > 0

			if (c_pix4 == MLO_N_IN_HORIZ_READS - 1)
			{
				for (int i = 0; i < MLO_IN_N_PIXS_OFF; ++i)
				{

					in_rd_data[i] = bot[gbl_in_scan_off + c*MLO_IN_CHANNEL_STRIDE + c_scan* MLO_IN_STRIDE + c_pix4*MLO_READ_UNIT + i];
				}

				for (int i = MLO_READ_UNIT - 1; i >= MLO_READ_UNIT - MLO_IN_N_PIXS_OFF; --i)
				{
					in_rd_data[i] = 0;
				}

			}
			else
#endif
			{
				*(MLO_READ_TYPE*)in_rd_data = *(MLO_READ_TYPE*)&bot[gbl_in_scan_off + c*MLO_IN_CHANNEL_STRIDE + c_scan* MLO_IN_STRIDE + c_pix4*MLO_READ_UNIT];
			}

// stack of inputs, each has 1 line
			for (int i = 0; i < MLO_READ_UNIT; ++i)
			{
				int lcl_in_off = c*MLO_IN_LCL_SZ + c_scan* MLO_IN_LCL_WIDTH + MLO_FILTER_PAD0 + c_pix4*MLO_READ_UNIT + i;
				lcl_bot[lcl_in_off] = in_rd_data[i];
#if 0
				if (c == 0 && c_scan ==1 && c_pix4 == 0)
				{
					printf("K:g: %d %d %d %d %f\n",
						lcl_id,
						c_scan,
						i,
						lcl_in_off,
						lcl_bot[lcl_in_off]
					);
				}
#endif
			}
		}

	} // for (int p4 = lcl_id; p4 < MLO_N_LCL_IN_MAPS * MLO_N_IN_HORIZ_READS * MLO_IN_VERT_READS;

	barrier(CLK_LOCAL_MEM_FENCE);

}

inline void Processing(int sc, int sc_lcl_off, int top_lim, int bot_lim, __private _FLOAT * pvt_accum, __local _FLOAT * lcl_bot, __private _FLOAT * top_dat)
{
	for (int l = top_lim; l >= bot_lim; --l)
	{
		for (int m = 0; m < MLO_IN_TILE0; ++m)
		{
			for (int n = 0; n < MLO_FILTER_SIZE0; ++n)
			{
				_FLOAT bot_val = lcl_bot[sc_lcl_off + n + m];
				_FLOAT top_val = top_dat[(top_lim - l) * MLO_IN_TILE0 + m];
				pvt_accum[l*MLO_FILTER_SIZE0 + n]
					// each wk-item process an input
					+= bot_val * top_val;
#if 1
				if (/*bot_val * top_val != 0 && */get_global_id(1) == 0 && get_global_id(2) == 0 && get_local_id(0) == 0 && l == 2 && n == 0)
				{
					printf("G: %d %d  %f %f %f %f\n",
						sc,
						sc_lcl_off,
						pvt_accum[l*MLO_FILTER_SIZE0 + n],
						bot_val * top_val,
						bot_val,
						top_val
					);
				}
#endif

			}

		}

	}

}
/*********************************************************************************************************
// wrw algorithm for large filters
// idea:
// split output line line on number of spans by number of waves
// read MLO_FILTER_SIZE1 number of such spans into SGPS (for example 5 *7 = 35)
// read 1 input line for 64 maps into LDS
//
// alg
//
// accumulate 1 scan of data per wave per each input map per wk-item

**********************************************************************************************************/

__attribute__((reqd_work_group_size(MLO_GRP_SZ0, MLO_GRP_SZ1, MLO_GRP_SZ2)))
__kernel void MLOpenCvBwdWrW(
	const __global _FLOAT * top_df,
	const __global _FLOAT * bot,
	__global _FLOAT * weights_df,
#if MLO_CONV_BIAS
	__global _FLOAT * bias_df,
#endif
	_FLOAT padding_val
)
{

	// input/output tiles + reduce buffer

	__local _FLOAT lcl[(MLO_LCL_SZ)];
	__local _FLOAT * lcl_bot = lcl;

	// guarnteeing an uniformity over a wave
	int wave_id = getWaveId();
	int lcl_id = get_local_id(0);
	int lcl_wv_id = gePhysLocalId();

	int c_idx_base = get_group_id(1); // input map index base

	int o_idx_base = iDiv(get_group_id(2), (MLO_BATCH_SZ / (MLO_N_BATCH_LOOPS*MLO_N_LCL_BATCHS))); // output map index base
	int ib_base = iMod(get_group_id(2), o_idx_base, (MLO_BATCH_SZ / (MLO_N_BATCH_LOOPS*MLO_N_LCL_BATCHS)));

	int ib = ib_base*MLO_N_LCL_BATCHS;

	int c_idx = c_idx_base * MLO_N_LCL_IN_MAPS; // input map index

	int o_idx = o_idx_base * (MLO_N_LCL_OUT_MAPS * MLO_OUT_STACKS); // output map index

	int gbl_in_off = c_idx * MLO_IN_CHANNEL_STRIDE + ib * MLO_IN_BATCH_STRIDE;
	int gbl_out_off = o_idx * MLO_OUT_CHANNEL_STRIDE + ib * MLO_OUT_BATCH_STRIDE;
// 1 span per wk_item, total scanline with MLO_N_SPANS_PER_SCAN spans
// TODO: more than 1 input
	int o = iDiv(lcl_id, MLO_N_SPANS_PER_SCAN);
	bool scan_lead = (o*MLO_N_SPANS_PER_SCAN == lcl_id);
	int spn = iMod(lcl_id, o, MLO_N_SPANS_PER_SCAN);
#define MLO_TOP_DAT_SZ (MLO_IN_TILE0 * MLO_FILTER_SIZE1)
	int lcl_bot_off = spn * MLO_IN_TILE0;
	int out_wk_item_off = o * MLO_OUT_CHANNEL_STRIDE + lcl_bot_off;
	gbl_out_off += out_wk_item_off;

	__private _FLOAT top_dat[MLO_TOP_DAT_SZ];

	for (int i = 0; i < MLO_TOP_DAT_SZ; ++i)
	{
		top_dat[i] = 0;
	}

#define MLO_ACCUM_SZ (MLO_FILTER_SIZE1*MLO_FILTER_SIZE0)

	__private _FLOAT pvt_accum[MLO_ACCUM_SZ];

	for (int i = 0; i < MLO_ACCUM_SZ; ++i)
	{
		pvt_accum[i] = 0;
	}

	// zero out LDS
	for (int i = lcl_id; i < (MLO_LCL_SZ); i += MLO_GRP_SZ)
	{
		lcl[i] = 0;
	}

//	barrier(CLK_LOCAL_MEM_FENCE);

	// over all batches

	for (int b = 0;
		b < MLO_N_BATCH_LOOPS;
		++b,
		gbl_in_off += MLO_N_LCL_BATCHS*MLO_IN_BATCH_STRIDE,
		gbl_out_off += MLO_N_LCL_BATCHS*MLO_OUT_BATCH_STRIDE
		)
	{
		int in_y = 0;
	//	int out_y = 0;

		int gbl_in_scan_off = gbl_in_off;
		int gbl_out_scan_off = gbl_out_off;
		// over all out blocks
		// processing per MLO_N_ALIGNED_OUT_SCAN_BLK output scans

		// read input line
		readInput(lcl_id, gbl_in_scan_off, bot, lcl_bot);

		// prefetch output
		for (int j = 0; j < MLO_FILTER_SIZE1 - 1; ++j)
		{
			int top_df_off = gbl_out_scan_off;
			_FLOAT mask = 1;
#if MLO_FILTER_SIZE1 - 1 > MLO_OUT_HEIGHT
			top_df_off = (j < MLO_OUT_HEIGHT) ? top_df_off : 0;
			mask = (j < MLO_OUT_HEIGHT) ? 1 : 0;
#endif
			for (int i = 0; i < MLO_IN_TILE0; ++i)
			{
				_FLOAT top_val = top_df[top_df_off + j * MLO_OUT_STRIDE + i] * mask;
				top_dat[j*MLO_IN_TILE0 + i] = top_val;
			}
		}

		barrier(CLK_LOCAL_MEM_FENCE);

		// prolog
		// handling padding

		int sc = 0;
		int sc_lcl_off = lcl_bot_off;
// pad0

// processing
		Processing(sc, sc_lcl_off, MLO_FILTER_PAD1, 0, pvt_accum, lcl_bot, top_dat);
		gbl_out_scan_off += MLO_OUT_STRIDE;
		sc++;
		sc_lcl_off += MLO_IN_LCL_WIDTH;

// pad1
		Processing(sc, sc_lcl_off, MLO_FILTER_PAD1 + 1, 0, pvt_accum, lcl_bot, top_dat);
		gbl_out_scan_off += MLO_OUT_STRIDE;
		sc++;
		sc_lcl_off += MLO_IN_LCL_WIDTH;

// generic

		for (; sc < MLO_OUT_HEIGHT - MLO_FILTER_PAD1 - (MLO_FILTER_SIZE1 - 2 - MLO_FILTER_PAD1); ++sc, gbl_out_scan_off += MLO_OUT_STRIDE, sc_lcl_off += MLO_IN_LCL_WIDTH)
		{

			int top_df_off = gbl_out_scan_off;
			_FLOAT mask = 1;

#if MLO_FILTER_SIZE1 > MLO_OUT_HEIGHT
			top_df_off = ((sc + MLO_FILTER_SIZE1 - 2) < MLO_OUT_HEIGHT) ? top_df_off : 0;
			mask = ((sc + MLO_FILTER_SIZE1 - 2) < MLO_OUT_HEIGHT) ? 1 : 0;
#endif
			// move in the last output scans
			// !!!! 2 is seleted because compiler cannot handle register allocation properly
			for (int j = 2; j < MLO_FILTER_SIZE1; ++j)
			{
				for (int i = 0; i < MLO_IN_TILE0; ++i)
				{
					top_dat[j *MLO_IN_TILE0 + i] = top_df[top_df_off + (j-2) * MLO_OUT_STRIDE + i] * mask;
				}

			}

			  // processing
			Processing(sc, sc_lcl_off, MLO_FILTER_SIZE1 - 1, 0, pvt_accum, lcl_bot, top_dat);
// move up output
// !!!! 2 is seleted because compiler cannot handle register allocation properly
			for (int j = 0; j < 2/*MLO_FILTER_SIZE1 - 1*/; ++j)
			{
				for (int i = 0; i < MLO_IN_TILE0; ++i)
				{
					top_dat[j*MLO_IN_TILE0 + i] = top_dat[(j+1)*MLO_IN_TILE0 + i];
				}
			}

		}

#if 0
		{
			int top_df_off = gbl_out_scan_off;
			_FLOAT mask = 1;

#if MLO_FILTER_SIZE1 > MLO_OUT_HEIGHT
			top_df_off = ((sc + MLO_FILTER_SIZE1 - 2) < MLO_OUT_HEIGHT) ? top_df_off : 0;
			mask = ((sc + MLO_FILTER_SIZE1 - 2) < MLO_OUT_HEIGHT) ? 1 : 0;
#endif
			// move in the last output scans
			// !!!! 2 is seleted because compiler cannot handle register allocation properly
			for (int j = 2; j < MLO_FILTER_SIZE1 - 1; ++j)
			{
				for (int i = 0; i < MLO_IN_TILE0; ++i)
				{
					top_dat[j *MLO_IN_TILE0 + i] = top_df[top_df_off + (j - 2) * MLO_OUT_STRIDE + i] * mask;
				}

			}
		}
#endif
// epilog
// handling padding
// pad1
//		for (; sc < MLO_OUT_HEIGHT - MLO_FILTER_PAD1 + 1; ++sc, sc_lcl_off += MLO_IN_LCL_WIDTH)
		{

			  // processing
			Processing(sc, sc_lcl_off, MLO_FILTER_SIZE1 - 1, MLO_FILTER_PAD1 - 1, pvt_accum, lcl_bot, top_dat);
			  // move up output
			for (int j = 0; j < MLO_FILTER_SIZE1 - 2; ++j)
			{
				for (int i = 0; i < MLO_IN_TILE0; ++i)
				{
					top_dat[j*MLO_IN_TILE0 + i] = top_dat[(j + 1)*MLO_IN_TILE0 + i];
				}
			}

		} // for (; sc < MLO_OUT_HEIGHT - MLO_FILTER_PAD1 + 1; ++sc, gbl_out_scan_off += MLO_OUT_CHANNEL_STRIDE, gbl_in_scan_off += MLO_IN_CHANNEL_STRIDE)
		++sc;
		sc_lcl_off += MLO_IN_LCL_WIDTH;

// pad0
//		for (; sc < MLO_OUT_HEIGHT; ++sc, , sc_lcl_off += MLO_IN_LCL_WIDTH)
		{
			// processing
			Processing(sc, sc_lcl_off, MLO_FILTER_SIZE1 - 1, MLO_FILTER_PAD1, pvt_accum, lcl_bot, top_dat);
		} // for (; sc < MLO_OUT_HEIGHT - MLO_FILTER_PAD1 + 2; ++sc, gbl_out_scan_off += MLO_OUT_CHANNEL_STRIDE, gbl_in_scan_off += MLO_IN_CHANNEL_STRIDE)

	} // 	for (int b = 0;

// final summation
	for (int l = 0; l < MLO_FILTER_SIZE1; ++l)
	{
		for (int n = 0; n < MLO_FILTER_SIZE0; ++n)
		{
			lcl[lcl_id * MLO_FILTER_SIZE0 + n] =
				pvt_accum[l*MLO_FILTER_SIZE0 + n];
#if 0
			if (lcl_wv_id == 0 && l == 2 && n == 3)
			{
				printf("G:s1: %f\n",
					pvt_accum[l*MLO_FILTER_SIZE0 + n]
				);
			}
#endif

		}

		barrier(CLK_LOCAL_MEM_FENCE);

		if (scan_lead)
		{
			for (int s = 0; s < MLO_N_SPANS_PER_SCAN - 1; ++s)
			{

				for (int n = 0; n < MLO_FILTER_SIZE0; ++n)
				{
					pvt_accum[l*MLO_FILTER_SIZE0 + n]
						+= lcl[(lcl_id + s + 1) * MLO_FILTER_SIZE0 + n];
#if 0
					if (lcl_wv_id == 0 && l == 2 && n == 3)
					{
						printf("G:s2: %f %f\n",
							pvt_accum[l*MLO_FILTER_SIZE0 + n],
							lcl[(w* MLO_HW_WAVE_SZ + lcl_wv_id) * MLO_FILTER_SIZE0 + n]
						);
					}
#endif

				}

			}
		}

		barrier(CLK_LOCAL_MEM_FENCE);
	}

// output
// inputs are outputs
// TODO : for more than 1 input
	int c = 0;

	int wei_df_off = ((ib * MLO_N_OUTPUTS + o_idx + o) * (int)MLO_WEI_BATCH_STRIDE)
		// this input channel
		+ mul24((c_idx + c), (int)MLO_WEI_CHANNEL_STRIDE);
	if (scan_lead && o_idx + o < MLO_N_OUTPUTS)
	{
		for (int i = 0; i < (MLO_FILTER_SIZE1 * MLO_FILTER_SIZE0); ++i)
		{
			weights_df[wei_df_off + i] = pvt_accum[i];
		}

	}

}

// final reduction kernel
// add filters over batches
__attribute__((reqd_work_group_size(MLO_UT_GRP_SZ0, 1, 1)))
__kernel void MLOpenCvBwdWrW_rdc(
	const __global _FLOAT * weight_df_tmp,
	__global _FLOAT * weights_df
)
{
	int gbl_id = get_global_id(0);
	int wei_idx0 = gbl_id * MLO_UT_READ_UNIT;

	int wei_blk_idx = iDiv(wei_idx0, MLO_WEI_CHANNEL_STRIDE);
	int wei_idx = iMod(wei_idx0, wei_blk_idx, MLO_WEI_CHANNEL_STRIDE);

	_FLOAT pvt_accum_wei[MLO_UT_READ_UNIT];
	for (int i = 0; i < MLO_UT_READ_UNIT; ++i)
	{
		pvt_accum_wei[i] = 0;
	}

	int batch_loop = (MLO_BATCH_SZ + (MLO_N_BATCH_LOOPS*MLO_N_LCL_BATCHS) - 1) / (MLO_N_BATCH_LOOPS*MLO_N_LCL_BATCHS);
	for (int i = 0; i < batch_loop; ++i)
	{
		*(MLO_UT_READ_TYPE*)pvt_accum_wei
			+= *(MLO_UT_READ_TYPE*)&weight_df_tmp[(wei_blk_idx * MLO_WEI_CHANNEL_STRIDE + i* MLO_N_OUTPUTS*MLO_WEI_BATCH_STRIDE)  + wei_idx];
	}

	*(MLO_UT_READ_TYPE*)&weights_df[wei_idx0] = *(MLO_UT_READ_TYPE*)pvt_accum_wei;

}